The Structure of Deception: Validation of the Lying Profile Questionnaire
Supplementary Materials 1: Statistical Analysis
Dominique Makowski, Tam Pham, Zen J. Lau, Adrian Raine, & S.H. Annabel Chen
Methods
Packages & Data
Packages
library(tidyverse)
library(easystats)> # Attaching packages
> <U+2714> insight 0.11.1.1 <U+2714> bayestestR 0.8.0.1
> <U+2714> performance 0.6.1 <U+2714> parameters 0.10.1
> <U+2714> see 0.6.1.1 <U+2714> effectsize 0.4.1.1
> <U+2714> correlation 0.5.0 <U+2714> modelbased 0.4.0
> <U+2714> report 0.2.0
> Warnings or errors in CRAN checks for package(s) 'insight', 'parameters'.set.seed(333)Data
labels <- read.csv("labels.csv", stringsAsFactors = FALSE) %>%
mutate(Item = paste0(Questionnaire, "_", Item))
df_raw <- read.csv("data.csv", stringsAsFactors = FALSE)Preprocessing
df_raw <- df_raw %>%
mutate(Participant = paste0("S", 1:nrow(df_raw)),
Sex = as.factor(Sex))
paste("The initial sample included", report::report_participants(df_raw))> [1] "The initial sample included 1011 participants (Mean age = 25.6, SD = 7.9, range: [13.0, 73.51]; 55.1% females; Mean education = 3.4, SD = 2.2, range: [-7, 10])"Measures Scoring
Utility Functions
# Reverse negative items
reverse <- function(x, mini, maxi){
maxi - x + mini
}
# Descriptive statistics
descriptive_statistics <- function(df, begins_with){
df %>%
select(dplyr::starts_with(begins_with)) %>%
report() %>%
as.data.frame() %>%
select(-one_of(c("n_Obs", "Median", "MAD", "n_Missing"))) %>%
print()
plot(df %>%
select(dplyr::starts_with(begins_with)) %>%
bayestestR::estimate_density(method = "KernSmooth") %>%
plot() +
see::theme_modern())
}Deception and Lying Profile (LIE)
We rescaled the LIE variables, originally scored on a -10 to 10 scale, to -5 to 5, so that the coefficients are more easily interpretable (i.e., refers to a change of 10% of the scale).
df_raw[stringr::str_detect(names(df_raw), "LIE_")] <- effectsize::change_scale(df_raw[stringr::str_detect(names(df_raw), "LIE_")], from = c(-10, 10), to = c(-5, 5))Psychopathy (TRIMP)
df_raw <- df_raw %>%
# Transform to numeric
mutate_at(vars(starts_with("TRIMP")), function(x) {
ifelse(x == "TRUE", 3,
ifelse(x == "somewhat true", 2,
ifelse(x == "somewhat false", 1, 0)))
}) %>%
# Reverse items
mutate_at(vars("TRIMP_2", "TRIMP_4", "TRIMP_10", "TRIMP_11", "TRIMP_16", "TRIMP_21", "TRIMP_25", "TRIMP_30", "TRIMP_33", "TRIMP_35", "TRIMP_39", "TRIMP_41", "TRIMP_44", "TRIMP_47", "TRIMP_50", "TRIMP_52", "TRIMP_57"), reverse, mini = 0, maxi = 3) %>%
# Compute scores
## Boldness
mutate(
TRIMP_Boldness = (TRIMP_1 + TRIMP_16
+ TRIMP_7 + TRIMP_32
+ TRIMP_10 + TRIMP_28
+ TRIMP_13 + TRIMP_41
+ TRIMP_19 + TRIMP_38 + TRIMP_57
+ TRIMP_4 + TRIMP_47
+ TRIMP_22 + TRIMP_35
+ TRIMP_25 + TRIMP_50
+ TRIMP_44 + TRIMP_54)/19,
TRIMP_Boldness_Optimism = (TRIMP_1 + TRIMP_16)/2,
TRIMP_Boldness_Resilience = (TRIMP_7 + TRIMP_32)/2,
TRIMP_Boldness_Courage = (TRIMP_10 + TRIMP_28)/2,
TRIMP_Boldness_Dominance = (TRIMP_13 + TRIMP_41)/2,
TRIMP_Boldness_Persuasiveness = (TRIMP_19 + TRIMP_38 + TRIMP_57)/3,
TRIMP_Boldness_Intrepidness = (TRIMP_4 + TRIMP_47)/2,
TRIMP_Boldness_ToleranceForUncertainty = (TRIMP_22 + TRIMP_35)/2,
TRIMP_Boldness_SelfConfidence = (TRIMP_25 + TRIMP_50)/2,
TRIMP_Boldness_SocialAssurance = (TRIMP_44 + TRIMP_54)/2
) %>%
## Meanness
mutate(
TRIMP_Meanness = (TRIMP_2 + TRIMP_8 + TRIMP_11 + TRIMP_20 + TRIMP_29 + TRIMP_33 + TRIMP_36 + TRIMP_48 + TRIMP_52 + TRIMP_55
+ TRIMP_6 + TRIMP_45
+ TRIMP_14
+ TRIMP_17 + TRIMP_23 + TRIMP_26 + TRIMP_42
+ TRIMP_39
+ TRIMP_40)/19,
TRIMP_Meanness_Empathy = (TRIMP_2 + TRIMP_8 + TRIMP_11 + TRIMP_20 + TRIMP_29 + TRIMP_33 + TRIMP_36 + TRIMP_48 + TRIMP_52 + TRIMP_55)/10,
TRIMP_Meanness_ExcitementSeeking = (TRIMP_6 + TRIMP_45)/2,
TRIMP_Meanness_PhysicalAggression = TRIMP_14,
TRIMP_Meanness_RelationalAggression = (TRIMP_17 + TRIMP_23 + TRIMP_26 + TRIMP_42)/4,
TRIMP_Meanness_Honesty = TRIMP_39,
TRIMP_Meanness_DestructiveAggression = TRIMP_40
) %>%
## Disinhibition
mutate(
TRIMP_Disinhibition = (
TRIMP_3 + TRIMP_46 +
TRIMP_5 + TRIMP_30 +
TRIMP_9 + TRIMP_15 + TRIMP_37 + TRIMP_51 +
TRIMP_12 + TRIMP_18 + TRIMP_49 + TRIMP_56 +
TRIMP_21 +
TRIMP_24 + TRIMP_43 + TRIMP_53 + TRIMP_58 +
TRIMP_27 +
TRIMP_31 +
TRIMP_34)/20,
TRIMP_Disinhibition_ImpatienceUrgency = (TRIMP_3 + TRIMP_46)/2,
TRIMP_Disinhibition_Dependability = (TRIMP_5 + TRIMP_30)/2,
TRIMP_Disinhibition_ProblematicImpulsivity = (TRIMP_9 + TRIMP_15 + TRIMP_37 + TRIMP_51)/4,
TRIMP_Disinhibition_Irresponsibility = (TRIMP_12 + TRIMP_18 + TRIMP_49 + TRIMP_56)/4,
TRIMP_Disinhibition_PlanfulControl = TRIMP_21,
TRIMP_Disinhibition_Theft = (TRIMP_24 + TRIMP_43 + TRIMP_53 + TRIMP_58)/4,
TRIMP_Disinhibition_Alienation = TRIMP_27,
TRIMP_Disinhibition_BoredomProneness = TRIMP_31,
TRIMP_Disinhibition_Fraud = TRIMP_34
) %>%
## General
mutate(TRIMP_General = (TRIMP_Boldness*19 + TRIMP_Meanness*19 + TRIMP_Disinhibition*20)/58
) %>%
# Remove individual questions
select(-matches("TRIMP_\\d"))Narcissism (FFNI)
df_raw <- df_raw %>%
# Transform to numeric
mutate_at(vars(starts_with("FFNI")), function(x) {
ifelse(x == "Disagree strongly", 1,
ifelse(x == "Disagree a little", 2,
ifelse(x == "Neither agree nor disagree", 3,
ifelse(x == "Agree a little", 4, 5))))
})%>%
# Reverse items
mutate_at(vars("FFNI_19", "FFNI_27"), reverse, mini = 1, maxi = 5) %>%
# Compute scores
mutate(
FFNI_AcclaimSeeking = (FFNI_1 + FFNI_16 + FFNI_31 + FFNI_46),
FFNI_Distrust = (FFNI_4 + FFNI_19 + FFNI_34 + FFNI_49),
FFNI_Entitlement = (FFNI_5 + FFNI_20 + FFNI_35 + FFNI_50),
FFNI_Exploitativeness = (FFNI_7 + FFNI_22 + FFNI_37 + FFNI_52),
FFNI_Indifference = (FFNI_9 + FFNI_24 + FFNI_39 + FFNI_54),
FFNI_LackOfEmpathy = (FFNI_10 + FFNI_25 + FFNI_40 + FFNI_55),
FFNI_Manipulativeness = (FFNI_11 + FFNI_26 + FFNI_41 + FFNI_56),
FFNI_NeedForAdmiration = (FFNI_12 + FFNI_27 + FFNI_42 + FFNI_57),
FFNI_ThrillSeeking = (FFNI_15 + FFNI_30 + FFNI_45 + FFNI_60),
FFNI_General = (FFNI_AcclaimSeeking + FFNI_Entitlement + FFNI_NeedForAdmiration + FFNI_Manipulativeness + FFNI_LackOfEmpathy + FFNI_Indifference + FFNI_ThrillSeeking + FFNI_Distrust + FFNI_Exploitativeness) / 9
) %>%
# Remove individual questions
select(-matches("FFNI_\\d"))Normal Personality (IPIP6)
df_raw <- df_raw %>%
# Transform to numeric
mutate_at(vars(starts_with("IPIP6")), as.numeric) %>%
# Reverse items
mutate_at(vars("IPIP6_6", "IPIP6_7", "IPIP6_8", "IPIP6_9", "IPIP6_11", "IPIP6_12", "IPIP6_13", "IPIP6_15", "IPIP6_17", "IPIP6_18", "IPIP6_19", "IPIP6_20", "IPIP6_21", "IPIP6_22", "IPIP6_24"), reverse, mini = 1, maxi = 7) %>%
# Compute scores
mutate(
IPIP6_Extraversion = (IPIP6_1 + IPIP6_7 + IPIP6_19 + IPIP6_23)/4,
IPIP6_Agreableness = (IPIP6_2 + IPIP6_8 + IPIP6_14 + IPIP6_20)/4,
IPIP6_Conscientiousness = (IPIP6_3 + IPIP6_10 + IPIP6_11 + IPIP6_22)/4,
IPIP6_Neuroticism = (IPIP6_4 + IPIP6_15 + IPIP6_16 + IPIP6_17)/4,
IPIP6_Openness = (IPIP6_5 + IPIP6_9 + IPIP6_13 + IPIP6_21)/4,
IPIP6_HonestyHumility = (IPIP6_6 + IPIP6_12 + IPIP6_18 + IPIP6_24)/4
) %>%
# Remove individual questions
select(-matches("IPIP6_\\d"))Pathological Personality (PID-5)
df_raw <- df_raw %>%
# Transform to numeric
mutate_at(vars(starts_with("PID5")), function(x) {
ifelse(x == "Very false or often false", 0,
ifelse(x == "Sometimes or somewhat false", 1,
ifelse(x == "Sometimes or somewhat true", 2, 3)))
}) %>%
# Compute scores
mutate(
PID5_NegativeAffect = (PID5_8 + PID5_9 + PID5_10 + PID5_11 + PID5_15)/5,
PID5_Detachment = (PID5_4 + PID5_13 + PID5_14 + PID5_16 + PID5_18)/5,
PID5_Antagonism = (PID5_17 + PID5_19 + PID5_20 + PID5_22 + PID5_25)/5,
PID5_Disinhibition = (PID5_1 + PID5_2 + PID5_3 + PID5_5 + PID5_6)/5,
PID5_Psychoticism = (PID5_7 + PID5_12 + PID5_21 + PID5_23 + PID5_24)/5,
PID5_Pathology = (PID5_NegativeAffect + PID5_Detachment + PID5_Antagonism + PID5_Disinhibition + PID5_Psychoticism)/5
) %>%
# Remove individual questions
select(-matches("PID5_\\d"))Impulsivity (UPPS)
df_raw <- df_raw %>%
# Transform to numeric
mutate_at(vars(starts_with("UPPS")), function(x) {
ifelse(x == "Strongly Agree", 1,
ifelse(x == "Somewhat agree", 2,
ifelse(x == "Somewhat disagree", 3, 4)))
})%>%
# Reverse items
mutate_at(vars("UPPS_3", "UPPS_6", "UPPS_8", "UPPS_9", "UPPS_10", "UPPS_13", "UPPS_14", "UPPS_15", "UPPS_16", "UPPS_17", "UPPS_18", "UPPS_20"), reverse, mini = 1, maxi = 4) %>%
# Compute scores
mutate(
UPPS_NegativeUrgency = (UPPS_6 + UPPS_8 + UPPS_13 + UPPS_15)/4,
UPPS_PositiveUrgency = (UPPS_3 + UPPS_10 + UPPS_17 + UPPS_20)/4,
UPPS_LackOfPerseverance = (UPPS_1 + UPPS_4 + UPPS_7 + UPPS_11)/4,
UPPS_LackOfPremeditation = (UPPS_2 + UPPS_5 + UPPS_12 + UPPS_19)/4,
UPPS_SensationSeeking = (UPPS_9 + UPPS_14 + UPPS_16 + UPPS_18)/4,
UPPS_General = (UPPS_NegativeUrgency + UPPS_PositiveUrgency + UPPS_LackOfPerseverance + UPPS_LackOfPremeditation + UPPS_SensationSeeking)/5
) %>%
# Remove individual questions
select(-matches("UPPS_\\d"))Emotion Regulation (DERS)
df_raw <- df_raw %>%
# Transform to numeric
mutate_at(vars(starts_with("DERS")), function(x) {
ifelse(x == "Almost never (0 - 10%)", 1,
ifelse(x == "Sometimes (11 - 35%)", 2,
ifelse(x == "About half the time (36 - 65%)", 3,
ifelse(x == "Most of the time (66 - 90%)", 4, 5))))
}) %>%
# Reverse items
mutate_at(vars("DERS_1", "DERS_4", "DERS_6"), reverse, mini = 1, maxi = 5) %>%
# Compute scores
mutate(
DERS_Awareness = DERS_1 + DERS_4 + DERS_6,
DERS_Clarity = DERS_2 + DERS_3 + DERS_5,
DERS_Goals = DERS_8 + DERS_12 + DERS_15,
DERS_Impulse = DERS_9 + DERS_16 + DERS_18,
DERS_NonAcceptance = DERS_7 + DERS_13 + DERS_14,
DERS_Strategies = DERS_10 + DERS_11 + DERS_17,
DERS_General = (DERS_Awareness + DERS_Clarity + DERS_Goals + DERS_Impulse + DERS_NonAcceptance + DERS_Strategies) / 6
) %>%
# Remove individual questions
select(-matches("DERS_\\d"))Light Triad (LTS)
df_raw <- df_raw %>%
# Transform to numeric
mutate_at(vars(starts_with("LTS")), function(x) {
ifelse(x == "Agree strongly", 1,
ifelse(x == "Agree", 2,
ifelse(x == "Neutral", 3,
ifelse(x == "Disagree", 4, 5))))
})%>%
# Compute scores
mutate(
LTS_FaithInHumanity = (LTS_1 + LTS_4 + LTS_7 + LTS_10)/4,
LTS_Humanism = (LTS_2 + LTS_5 + LTS_8 + LTS_11)/4,
LTS_Kantianism = (LTS_3 + LTS_6 + LTS_9 + LTS_12)/4,
LTS_General = (LTS_FaithInHumanity + LTS_Humanism + LTS_Kantianism)/3
) %>%
# Remove individual questions
select(-matches("LTS_\\d"))Introception (MAIA2)
df_raw <- df_raw %>%
# Compute scores
mutate(
MAIA2_Noticing = (MAIA2_1 + MAIA2_2 + MAIA2_3 + MAIA2_4)/4,
MAIA2_BodyListening = (MAIA2_5 + MAIA2_6 + MAIA2_7 + MAIA2_8 + MAIA2_9 + MAIA2_10 + MAIA2_11)/7
) %>%
# Remove individual questions
select(-matches("MAIA2_\\d"))Data Exclusion
Incomplete Data
df_incomplete <- df_raw %>%
filter_at(vars(matches("IPIP6|PID5|BIDR|MAIA|DERS|UPPS|FFNI|LTS|TRIMP|LIE_")), complete.cases) %>%
filter(Sex %in% c("Female", "Male")) %>%
droplevels()
paste("We excluded", nrow(df_raw) - nrow(df_incomplete), "participants with missing data.")> [1] "We excluded 5 participants with missing data."Time to complete
df_time <- df_incomplete %>%
mutate(Duration = Duration / 60) %>% # Express in minutes
filter(Duration < 120)
# Compute highest density intervals
ci <- bayestestR::eti(df_time$Duration, ci = c(0.8, 0.9, 0.95, 0.99))
cat(paste0("Duration Intervals:\n", paste0(" - ", insight::format_ci(ci$CI_low, ci$CI_high, ci$CI / 100), collapse = "\n")))> Duration Intervals:
> - 80% CI [13.09, 42.75]
> - 90% CI [10.95, 61.94]
> - 95% CI [9.42, 76.05]
> - 99% CI [7.52, 96.32]upper_limit <- ci[ci$CI == 90, "CI_high"]
lower_limit <- ci[ci$CI == 90, "CI_low"]
# Visualisation
ci %>%
plot(show_zero = FALSE, show_title = FALSE) +
geom_vline(xintercept = c(upper_limit, lower_limit), color="red", linetype="dotted") +
theme_modern() +
scale_fill_viridis_d() +
ylab("Distribution") +
xlab("Time to complete (in minutes)") 
df_time <- df_time %>%
filter(Duration < upper_limit,
Duration > lower_limit)
paste("We excluded", nrow(df_incomplete) - nrow(df_time), "participants with a completion time outside the 90% percentile (>", insight::format_value(lower_limit), "min and <", insight::format_value(upper_limit), "min).")> [1] "We excluded 141 participants with a completion time outside the 90% percentile (> 10.95 min and < 61.94 min)."Multivariate outliers
methods <- c("zscore", "iqr", "mahalanobis", "robust", "mcd", "ics", "iforest", "lof")
# outliers <- df_time %>%
# select(matches("LIE_|BIDR|IPIP6|PID5|TRIMP|FFNI|UPPS|DERS|LTS|MAIA"), -matches("_Profile|_General|_Pathology|Disinhibition_|Meanness_|Boldness_")) %>%
# select(matches("LIE_")) %>%
# effectsize::standardize() %>%
# performance::check_outliers(method = methods)
# Visualise
# as.data.frame(outliers) %>%
# mutate(Outlier = as.factor(paste0(round(Outlier*8), "/", length(methods)))) %>%
# ggplot(aes(x = Outlier, fill = Outlier)) +
# geom_bar() +
# geom_vline(aes(xintercept = 6.5), color = "red", linetype = "dotted") +
# theme_modern() +
# see::scale_fill_metro_d(guide = FALSE) +
# xlab("Proportion of methods aggreeing on an outlier") +
# ylab("Number of participants")
# save(outliers, file="outliers.Rdata")
load("outliers.Rdata")
df <- df_time[-which(as.numeric(outliers) >= 6/length(methods)), ]
paste("Based on a composite outlier score (see the 'check_outliers' function in the 'performance' R package; Lüdecke et al., 2019) obtained via the joint application of multiple outliers detection algorithms (Z-scores, Iglewicz, 1993; Interquartile range (IQR); Mahalanobis distance, Cabana, 2019; Robust Mahalanobis distance, Gnanadesikan & Kettenring, 1972; Minimum Covariance Determinant, Leys et al., 2018; Invariant Coordinate Selection, Archimbaud et al., 2018; Isolation Forest, Liu et al. 2008; and Local Outlier Factor, Breunig et al., 2000), we excluded", nrow(df_time) - nrow(df), "participants that were classified as outliers by at least 6/8 of the methods used.")> [1] "Based on a composite outlier score (see the 'check_outliers' function in the 'performance' R package; Lüdecke et al., 2019) obtained via the joint application of multiple outliers detection algorithms (Z-scores, Iglewicz, 1993; Interquartile range (IQR); Mahalanobis distance, Cabana, 2019; Robust Mahalanobis distance, Gnanadesikan & Kettenring, 1972; Minimum Covariance Determinant, Leys et al., 2018; Invariant Coordinate Selection, Archimbaud et al., 2018; Isolation Forest, Liu et al. 2008; and Local Outlier Factor, Breunig et al., 2000), we excluded 103 participants that were classified as outliers by at least 6/8 of the methods used."Final Sample
paste("The final sample included", report_participants(df))> [1] "The final sample included 762 participants (Mean age = 25.4, SD = 7.8, range: [19.0, 73.51]; 56.0% females; Mean education = 3.5, SD = 2.0, range: [-7, 10])"df <- df %>%
mutate(System_Screen = sqrt(System_Screen),
Education_Student = as.factor(ifelse(Education_Student == "", NA, Education_Student)),
Religion_Type = ifelse(Religion_Type == "", NA, Religion_Type),
Singapore_Duration = ifelse(Singapore_Duration > Age, NA, Singapore_Duration),
Singapore_Duration = Singapore_Duration / Age)
df %>%
select(System_Device, System_Screen, Duration, Education_Student, Education_Type, Ethnicity, starts_with("Religion"), Income, Singapore_Duration) %>%
report(levels_percentage = TRUE, missing_percentage = TRUE, n_entries = 10)> The data contains 762 observations of the following variables:
> - System_Device: 3 entries, such as Phone (74.15%%); Computer (25.07%%); Tablet (0.79%%); NA; NA; NA; NA; NA; NA; NA(0.00% missing)
> - System_Screen: n = 762, Mean = 692.93, SD = 265.01, Median = 552.00, MAD = 76.91, range: [426.33, 2225.67], Skewness = 1.50, Kurtosis = 1.63, 0% missing
> - Duration: n = 762, Mean = 23.90, SD = 9.69, Median = 21.23, MAD = 7.12, range: [10.97, 61.70], Skewness = 1.42, Kurtosis = 2.04, 0% missing
> - Education_Student: 2 levels, namely No (n = 229, 30.05%), Yes (n = 532, 69.82%) and missing (n = 1, 0.13%)
> - Education_Type: 18 entries, such as Business and Accountancy (22.31%%); Engineering (19.29%%); Social Sciences (Psychology, Sociology, etc.) (15.88%%); Sciences (10.89%%); Others (7.22%%); Computing (5.77%%); Humanities (Languages, History, etc.) (4.99%%); Communication Studies (3.28%%); Medicine (3.02%%); Art and Design (1.97%%) and 8 others(0.00% missing)
> - Ethnicity: 20 entries, such as Chinese (87.80%%); Malay (4.33%%); Indian (3.41%%); (1.84%%); Vietnamese (0.39%%); Eurasian (0.26%%); Korean (0.26%%); African (0.13%%); Arabic (0.13%%); Boyanese (0.13%%) and 10 others(0.00% missing)
> - Religion_Type: 6 entries, such as Buddhism (33.33%%); No religion (25.46%%); Christianity (24.80%%); Taoism (5.77%%); Islam (4.99%%); Hinduism (2.36%%); NA; NA; NA; NA(3.28% missing)
> - Religion_Religiosity: n = 762, Mean = 4.22, SD = 2.97, Median = , MAD = 4.45, range: [0, 10], Skewness = 0.06, Kurtosis = -1.26, 2.89% missing
> - Religion_Engagement: n = 762, Mean = 3.82, SD = 3.09, Median = , MAD = 4.45, range: [0, 10], Skewness = 0.30, Kurtosis = -1.18, 3.54% missing
> - Income: n = 762, Mean = 2802.21, SD = 4348.98, Median = , MAD = 1482.60, range: [0, 60000], Skewness = 8.46, Kurtosis = 96.78, 13.25% missing
> - Singapore_Duration: n = 762, Mean = 0.88, SD = 0.25, Median = , MAD = 0.02, range: [0, 1.00], Skewness = -2.51, Kurtosis = 4.85, 24.41% missingdf <- df %>%
mutate(Education_Type = ifelse(!Education_Type %in% c("Business and Accountancy",
"Engineering",
"Social Sciences (Psychology, Sociology...)",
"Sciences",
"Computing",
"Humanities (Languages, History...)"), "Other", Education_Type),
Ethnicity = ifelse(!Ethnicity %in% c("Chinese", "Malay", "Indian"), "Other", Ethnicity))Education and Income
report_participants(df, group = c("Sex", "Education_Student"))> [1] "For the 'Sex - Female and Education_Student - No' group: 136 participants (Mean age = 31.3, SD = 11.7, range: [21.7, 73.51]; 100.0% females; Mean education = 2.8, SD = 2.7, range: [-7, 6]), for the 'Sex - Male and Education_Student - No' group: 93 participants (Mean age = 30.9, SD = 11.9, range: [19.7, 66.19]; 0.0% females; Mean education = 2.1, SD = 2.8, range: [-6, 10]), for the 'Sex - Female and Education_Student - Yes' group: 291 participants (Mean age = 22.7, SD = 3.0, range: [19.1, 56.25]; 100.0% females; Mean education = 4.0, SD = 1.5, range: [0, 10]) and for the 'Sex - Male and Education_Student - Yes' group: 241 participants (Mean age = 23.3, SD = 2.1, range: [19.0, 39.79]; 0.0% females; Mean education = 3.9, SD = 1.3, range: [-2, 10])"as.data.frame(table(df$Education_Type)) %>%
ggplot(aes(x="", y =Freq, fill = reorder(Var1, -Freq))) +
geom_bar(width = 1, stat = "identity") +
labs(fill = "Course") +
coord_polar("y", start = 0, direction = -1) +
scale_fill_brewer(palette="Blues") +
theme_void() +
theme(legend.text = element_text(size = 20)) +
theme(legend.title = element_text(face = "bold", size = 20))
df %>%
filter(!is.na(Education_Student)) %>%
filter(Income < 18000) %>%
ggplot(aes(x = Income, colour = Education_Type)) +
geom_density(size = 1) +
facet_grid(~Education_Student, labeller = "label_both") +
theme_modern()
df %>%
filter(!is.na(Education_Student)) %>%
filter(Income < 18000) %>%
ggplot(aes(x = Age, y = Income, colour = Education_Type, fill = Education_Type)) +
geom_point2() +
geom_smooth(method = "lm", alpha = 0.1) +
theme_modern()
Culture
as.data.frame(table(df$Ethnicity)) %>%
ggplot(aes(x="", y = Freq, fill = reorder(Var1, -Freq))) +
labs(fill = "Ethnicity") +
geom_bar(width = 1, stat = "identity") +
coord_polar("y", start = 0) +
scale_fill_brewer(palette="Oranges") +
theme_void() +
theme(legend.text = element_text(size = 20)) +
theme(legend.title = element_text(face = "bold", size = 20))
df %>%
filter(!is.na(Singapore_Duration)) %>%
ggplot(aes(x = Singapore_Duration, colour = Ethnicity)) +
geom_density(size = 1) +
theme_modern() +
scale_x_continuous(labels = scales::percent)
Religion
as.data.frame(table(df$Religion_Type)) %>%
ggplot(aes(x="", y = Freq, fill = reorder(Var1, -Freq))) +
geom_bar(width = 1, stat = "identity") +
labs(fill = "Religion") +
coord_polar("y", start = 0) +
scale_fill_brewer(palette="Purples") +
theme_void() +
theme(legend.text = element_text(size = 20)) +
theme(legend.title = element_text(face = "bold", size = 20))
df %>%
filter(!is.na(Religion_Engagement)) %>%
filter(!is.na(Religion_Type)) %>%
ggplot(aes(x = Religion_Engagement, colour = Religion_Type)) +
geom_density(size = 1) +
theme_modern()
df %>%
filter(!is.na(Religion_Religiosity)) %>%
filter(!is.na(Religion_Type)) %>%
ggplot(aes(x = Religion_Religiosity, colour = Religion_Type)) +
geom_density(size = 1) +
theme_modern()
df %>%
filter(!is.na(Religion_Engagement)) %>%
filter(!is.na(Religion_Religiosity)) %>%
filter(!is.na(Religion_Type)) %>%
ggplot(aes(x = Religion_Religiosity, y = Religion_Engagement, colour = Religion_Type, fill = Religion_Type)) +
geom_jitter() +
geom_smooth(method = "lm", alpha = 0.2) +
ggtitle(paste("r =", insight::format_value(cor.test(df$Religion_Engagement, df$Religion_Religiosity)$estimate))) +
theme_modern()
df <- df %>%
mutate(Religion_Faith = (Religion_Engagement + Religion_Religiosity) / 2)Results
Descriptive Statistics
Deception and Lying Profile (LIE)
descriptive_statistics(df, "LIE_")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> ---------------------------------------------------------------------------------
> LIE_1 | -1.78 | 2.41 | -5.00 | 5.00 | 0.49 | -0.66 | 0.00
> LIE_2 | -1.40 | 2.54 | -5.00 | 5.00 | 0.37 | -0.82 | 0.00
> LIE_3 | -2.44 | 2.64 | -5.00 | 5.00 | 1.03 | 0.21 | 0.00
> LIE_4 | -1.61 | 2.46 | -5.00 | 5.00 | 0.40 | -0.72 | 0.00
> LIE_5 | -1.84 | 2.29 | -5.00 | 5.00 | 0.49 | -0.58 | 0.00
> LIE_6 | -1.00 | 2.58 | -5.00 | 5.00 | 0.17 | -1.01 | 0.00
> LIE_7 | -0.78 | 2.70 | -5.00 | 5.00 | 0.17 | -0.97 | 0.00
> LIE_8 | -1.37 | 2.29 | -5.00 | 5.00 | 0.41 | -0.43 | 0.00
> LIE_9 | -0.20 | 2.74 | -5.00 | 5.00 | -0.15 | -0.98 | 0.00
> LIE_10 | 0.13 | 2.72 | -5.00 | 5.00 | -0.27 | -0.88 | 0.00
> LIE_11 | -0.37 | 2.62 | -5.00 | 5.00 | -0.04 | -0.91 | 0.00
> LIE_12 | 0.77 | 2.64 | -5.00 | 5.00 | -0.56 | -0.52 | 0.00
> LIE_13 | -0.46 | 2.56 | -5.00 | 5.00 | 0.25 | -0.68 | 0.00
> LIE_14 | 0.42 | 2.46 | -5.00 | 5.00 | -0.38 | -0.58 | 0.00
> LIE_15 | 0.16 | 2.61 | -5.00 | 5.00 | -0.15 | -0.83 | 0.00
> LIE_16 | -1.00 | 2.39 | -5.00 | 5.00 | 0.38 | -0.41 | 0.00
> LIE_17 | 0.56 | 2.71 | -5.00 | 5.00 | -0.07 | -0.97 | 0.00
> LIE_18 | -0.02 | 2.67 | -5.00 | 5.00 | -0.23 | -0.93 | 0.00
> LIE_19 | 1.02 | 2.64 | -5.00 | 5.00 | -0.35 | -0.83 | 0.00
> LIE_20 | -0.18 | 2.61 | -5.00 | 5.00 | -0.06 | -0.86 | 0.00
> LIE_21 | -1.01 | 2.75 | -5.00 | 5.00 | 0.36 | -0.84 | 0.00
> LIE_22 | -2.26 | 2.35 | -5.00 | 5.00 | 0.67 | -0.43 | 0.00
> LIE_23 | -1.87 | 2.37 | -5.00 | 5.00 | 0.61 | -0.38 | 0.00
> LIE_24 | 1.24 | 2.36 | -5.00 | 5.00 | -0.39 | -0.48 | 0.00
> LIE_25 | 1.73 | 2.41 | -5.00 | 5.00 | -0.62 | -0.22 | 0.00
> LIE_26 | -2.61 | 2.20 | -5.00 | 5.00 | 0.89 | 0.15 | 0.00
> LIE_27 | 1.15 | 2.58 | -5.00 | 5.00 | -0.40 | -0.70 | 0.00
> LIE_28 | -0.26 | 2.56 | -5.00 | 5.00 | -0.10 | -0.76 | 0.00
> LIE_29 | -0.96 | 2.69 | -5.00 | 5.00 | 0.28 | -0.91 | 0.00
> LIE_30 | 0.39 | 2.69 | -5.00 | 5.00 | -0.33 | -0.84 | 0.00
> LIE_31 | -0.42 | 2.62 | -5.00 | 5.00 | -0.04 | -0.96 | 0.00
> LIE_32 | 0.53 | 2.67 | -5.00 | 5.00 | -0.37 | -0.74 | 0.00
> LIE_33 | 1.84 | 2.18 | -5.00 | 5.00 | -1.05 | 1.33 | 0.00
> LIE_34 | 2.64 | 2.00 | -5.00 | 5.00 | -0.76 | 0.31 | 0.00
> LIE_35 | 1.73 | 2.31 | -5.00 | 5.00 | -0.59 | -0.14 | 0.00
> LIE_36 | 1.02 | 2.41 | -5.00 | 5.00 | -0.25 | -0.65 | 0.00
> LIE_37 | 0.56 | 2.73 | -5.00 | 5.00 | -0.01 | -0.97 | 0.00
> LIE_38 | 1.81 | 2.51 | -5.00 | 5.00 | -0.55 | -0.60 | 0.00
> LIE_39 | 1.69 | 2.46 | -5.00 | 5.00 | -0.87 | 0.30 | 0.00
> LIE_40 | 1.80 | 2.42 | -5.00 | 5.00 | -0.73 | 0.06 | 0.00
> LIE_41 | 0.99 | 2.65 | -5.00 | 5.00 | -0.19 | -0.83 | 0.00
> LIE_42 | 1.87 | 2.22 | -5.00 | 5.00 | -0.76 | 0.58 | 0.00
> LIE_43 | 1.78 | 2.28 | -5.00 | 5.00 | -0.99 | 0.98 | 0.00
> LIE_44 | 2.05 | 2.39 | -5.00 | 5.00 | -0.67 | -0.14 | 0.00
Psychopathy (TRIMP)
df %>%
select(TRIMP_General, starts_with("TRIMP_Boldness"), starts_with("TRIMP_Meanness"), starts_with("TRIMP_Disinhibition")) %>%
report() %>%
as.data.frame() %>%
select(-one_of(c("n_Obs", "Median", "MAD", "n_Missing"))) %>%
print()> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> -------------------------------------------------------------------------------------------------------------------
> TRIMP_General | 1.08 | 0.28 | 0.34 | 1.90 | 0.25 | -0.30 | 0.00
> TRIMP_Boldness | 1.43 | 0.37 | 0.26 | 2.37 | -0.15 | -5.46e-03 | 0.00
> TRIMP_Boldness_Optimism | 1.72 | 0.56 | 0.00 | 3.00 | -0.31 | 0.20 | 0.00
> TRIMP_Boldness_Resilience | 1.55 | 0.63 | 0.00 | 3.00 | -0.13 | -0.28 | 0.00
> TRIMP_Boldness_Courage | 1.36 | 0.67 | 0.00 | 3.00 | 0.08 | -0.06 | 0.00
> TRIMP_Boldness_Dominance | 1.39 | 0.70 | 0.00 | 3.00 | -0.02 | -0.30 | 0.00
> TRIMP_Boldness_Persuasiveness | 1.53 | 0.59 | 0.00 | 3.00 | -0.18 | -0.18 | 0.00
> TRIMP_Boldness_Intrepidness | 1.06 | 0.73 | 0.00 | 3.00 | 0.32 | -0.59 | 0.00
> TRIMP_Boldness_ToleranceForUncertainty | 1.32 | 0.60 | 0.00 | 3.00 | 0.09 | 0.26 | 0.00
> TRIMP_Boldness_SelfConfidence | 1.58 | 0.66 | 0.00 | 3.00 | 0.11 | -0.35 | 0.00
> TRIMP_Boldness_SocialAssurance | 1.31 | 0.65 | 0.00 | 3.00 | 0.06 | -0.09 | 0.00
> TRIMP_Meanness | 0.88 | 0.40 | 0.00 | 2.05 | 0.24 | -0.44 | 0.00
> TRIMP_Meanness_Empathy | 0.80 | 0.45 | 0.00 | 2.10 | 0.23 | -0.64 | 0.00
> TRIMP_Meanness_ExcitementSeeking | 1.30 | 0.79 | 0.00 | 3.00 | 0.02 | -0.68 | 0.00
> TRIMP_Meanness_PhysicalAggression | 0.88 | 0.92 | 0.00 | 3.00 | 0.61 | -0.77 | 0.00
> TRIMP_Meanness_RelationalAggression | 1.02 | 0.63 | 0.00 | 2.75 | 0.23 | -0.62 | 0.00
> TRIMP_Meanness_Honesty | 0.79 | 0.69 | 0.00 | 3.00 | 0.61 | 0.33 | 0.00
> TRIMP_Meanness_DestructiveAggression | 0.35 | 0.63 | 0.00 | 3.00 | 1.70 | 1.96 | 0.00
> TRIMP_Disinhibition | 0.93 | 0.40 | 0.05 | 2.30 | 0.44 | -0.08 | 0.00
> TRIMP_Disinhibition_ImpatienceUrgency | 1.74 | 0.59 | 0.00 | 3.00 | -0.30 | 0.11 | 0.00
> TRIMP_Disinhibition_Dependability | 0.92 | 0.65 | 0.00 | 3.00 | 0.25 | -0.46 | 0.00
> TRIMP_Disinhibition_ProblematicImpulsivity | 1.11 | 0.63 | 0.00 | 2.75 | 0.03 | -0.66 | 0.00
> TRIMP_Disinhibition_Irresponsibility | 0.65 | 0.60 | 0.00 | 2.50 | 0.77 | -0.25 | 0.00
> TRIMP_Disinhibition_PlanfulControl | 1.09 | 0.64 | 0.00 | 3.00 | 0.45 | 0.74 | 0.00
> TRIMP_Disinhibition_Theft | 0.39 | 0.52 | 0.00 | 2.50 | 1.49 | 1.72 | 0.00
> TRIMP_Disinhibition_Alienation | 1.45 | 0.87 | 0.00 | 3.00 | -2.16e-03 | -0.67 | 0.00
> TRIMP_Disinhibition_BoredomProneness | 1.70 | 0.81 | 0.00 | 3.00 | -0.22 | -0.40 | 0.00
> TRIMP_Disinhibition_Fraud | 0.40 | 0.69 | 0.00 | 3.00 | 1.64 | 1.89 | 0.00plots(
df %>%
select(starts_with("TRIMP_Boldness")) %>%
bayestestR::estimate_density(method = "KernSmooth") %>%
plot() +
theme_modern(),
df %>%
select(starts_with("TRIMP_Meanness")) %>%
bayestestR::estimate_density(method = "KernSmooth") %>%
plot() +
theme_modern(),
df %>%
select(starts_with("TRIMP_Disinhibition")) %>%
bayestestR::estimate_density(method = "KernSmooth") %>%
plot() +
theme_modern()
)
Narcissism (FFNI)
descriptive_statistics(df, "FFNI")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> -----------------------------------------------------------------------------------------------
> FFNI_AcclaimSeeking | 14.19 | 3.33 | 4.00 | 20.00 | -0.62 | 0.41 | 0.00
> FFNI_Distrust | 12.27 | 2.83 | 4.00 | 20.00 | -0.04 | -0.02 | 0.00
> FFNI_Entitlement | 9.94 | 3.63 | 4.00 | 20.00 | 0.14 | -0.77 | 0.00
> FFNI_Exploitativeness | 9.01 | 3.67 | 4.00 | 20.00 | 0.34 | -0.80 | 0.00
> FFNI_Indifference | 11.03 | 3.75 | 4.00 | 20.00 | 0.22 | -0.63 | 0.00
> FFNI_LackOfEmpathy | 9.19 | 3.14 | 4.00 | 20.00 | 0.42 | -0.38 | 0.00
> FFNI_Manipulativeness | 10.31 | 3.66 | 4.00 | 20.00 | 0.13 | -0.78 | 0.00
> FFNI_NeedForAdmiration | 12.87 | 2.89 | 4.00 | 20.00 | -0.39 | 0.18 | 0.00
> FFNI_ThrillSeeking | 10.56 | 3.75 | 4.00 | 20.00 | 0.07 | -0.78 | 0.00
> FFNI_General | 11.04 | 1.95 | 5.89 | 19.44 | 0.19 | 0.32 | 0.00
Normal Personality (IPIP6)
descriptive_statistics(df, "IPIP6")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> -----------------------------------------------------------------------------------------------
> IPIP6_Extraversion | 3.58 | 1.20 | 1.00 | 6.75 | 0.13 | -0.56 | 0.00
> IPIP6_Agreableness | 4.99 | 0.90 | 1.25 | 7.00 | -0.29 | 0.11 | 0.00
> IPIP6_Conscientiousness | 4.48 | 1.07 | 1.00 | 7.00 | -0.24 | -3.94e-03 | 0.00
> IPIP6_Neuroticism | 3.91 | 1.09 | 1.00 | 7.00 | -0.02 | -0.21 | 0.00
> IPIP6_Openness | 4.53 | 1.05 | 1.50 | 7.00 | -0.10 | -0.38 | 0.00
> IPIP6_HonestyHumility | 4.39 | 1.24 | 1.25 | 7.00 | -0.04 | -0.60 | 0.00
Pathological Personality (PID-5)
descriptive_statistics(df, "PID5")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> ------------------------------------------------------------------------------------------
> PID5_NegativeAffect | 1.40 | 0.63 | 0.00 | 3.00 | -0.13 | -0.36 | 0.00
> PID5_Detachment | 1.08 | 0.55 | 0.00 | 3.00 | 0.10 | -0.17 | 0.00
> PID5_Antagonism | 0.89 | 0.54 | 0.00 | 3.00 | 0.38 | -0.10 | 0.00
> PID5_Disinhibition | 0.97 | 0.63 | 0.00 | 3.00 | 0.15 | -0.77 | 0.00
> PID5_Psychoticism | 1.24 | 0.60 | 0.00 | 3.00 | -0.09 | -0.31 | 0.00
> PID5_Pathology | 1.12 | 0.45 | 0.00 | 3.00 | -0.02 | 0.12 | 0.00
Social Desirability (BIDR)
descriptive_statistics(df, "BIDR")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> ----------------------------------------------------------------------------------------------------
> BIDR_SelfDeceptiveEnhancement | 3.90 | 0.80 | 1.50 | 7.00 | 0.09 | 0.45 | 0.00
> BIDR_ImpressionManagement | 3.82 | 0.81 | 1.12 | 6.62 | 0.21 | 0.51 | 0.00
> BIDR_General | 3.86 | 0.65 | 1.44 | 6.56 | 0.31 | 1.09 | 0.00
Impulsivity (UPPS)
descriptive_statistics(df, "UPPS")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> -----------------------------------------------------------------------------------------------
> UPPS_NegativeUrgency | 2.39 | 0.62 | 1.00 | 4.00 | -0.22 | -0.34 | 0.00
> UPPS_PositiveUrgency | 2.13 | 0.61 | 1.00 | 3.75 | -0.09 | -0.61 | 0.00
> UPPS_LackOfPerseverance | 1.85 | 0.44 | 1.00 | 3.25 | -0.02 | -0.14 | 0.00
> UPPS_LackOfPremeditation | 1.87 | 0.44 | 1.00 | 3.75 | -0.06 | 0.34 | 0.00
> UPPS_SensationSeeking | 2.68 | 0.65 | 1.00 | 4.00 | -0.24 | -0.26 | 0.00
> UPPS_General | 2.18 | 0.34 | 1.10 | 3.00 | -0.40 | -0.17 | 0.00
Emotion Regulation (DERS)
descriptive_statistics(df, "DERS")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> ------------------------------------------------------------------------------------------
> DERS_Awareness | 7.04 | 2.01 | 3.00 | 13.00 | 0.33 | -0.18 | 0.00
> DERS_Clarity | 7.42 | 2.46 | 3.00 | 15.00 | 0.44 | -0.18 | 0.00
> DERS_Goals | 9.36 | 3.16 | 3.00 | 15.00 | 7.17e-04 | -0.94 | 0.00
> DERS_Impulse | 6.76 | 2.96 | 3.00 | 15.00 | 0.58 | -0.48 | 0.00
> DERS_NonAcceptance | 7.32 | 3.04 | 3.00 | 15.00 | 0.49 | -0.55 | 0.00
> DERS_Strategies | 6.92 | 2.99 | 3.00 | 15.00 | 0.55 | -0.56 | 0.00
> DERS_General | 7.47 | 1.96 | 3.00 | 13.00 | 0.26 | -0.57 | 0.00
Light Triad (LTS)
descriptive_statistics(df, "LTS")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> ------------------------------------------------------------------------------------------
> LTS_FaithInHumanity | 2.38 | 0.62 | 1.00 | 4.50 | 0.54 | 0.54 | 0.00
> LTS_Humanism | 2.04 | 0.49 | 1.00 | 4.00 | 0.28 | 0.47 | 0.00
> LTS_Kantianism | 2.08 | 0.56 | 1.00 | 4.00 | 0.35 | 0.16 | 0.00
> LTS_General | 2.16 | 0.44 | 1.00 | 4.00 | 0.24 | 0.50 | 0.00
Interoception (MAIA2)
descriptive_statistics(df, "MAIA2")> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> ------------------------------------------------------------------------------------------
> MAIA2_Noticing | 3.15 | 0.85 | 0.00 | 5.00 | -0.44 | 0.22 | 0.00
> MAIA2_BodyListening | 2.82 | 0.89 | 0.00 | 5.00 | -0.40 | -0.06 | 0.00
Factor Structure
Splitting the data 50-50 for EFA-CFA
lie <- select(df, starts_with("LIE_"))
labels_lie <- labels[labels$Questionnaire == "LIE", ]
# Two sets of data 50-50
partitions <- parameters::data_partition(lie, training_proportion = 0.6)
lie_EFA <- partitions$training
lie_CFA <- partitions$test
# Compare stats across groups
group_indices = c(rep(2, round(nrow(lie)/2)), rep(1, nrow(lie) - round(nrow(lie)/2)))
lie_grouped <- cbind(lie, group_indices)
psych::statsBy(lie_grouped, group = "group_indices")> Statistics within and between groups
> Call: psych::statsBy(data = lie_grouped, group = "group_indices")
> Intraclass Correlation 1 (Percentage of variance due to groups)
> LIE_1 LIE_2 LIE_3 LIE_4 LIE_5
> 0.00 0.00 0.00 0.00 0.03
> LIE_6 LIE_7 LIE_8 LIE_9 LIE_10
> 0.01 0.00 0.00 0.00 0.00
> LIE_11 LIE_12 LIE_13 LIE_14 LIE_15
> 0.00 0.00 0.00 0.00 0.00
> LIE_16 LIE_17 LIE_18 LIE_19 LIE_20
> 0.00 0.00 0.00 0.00 0.00
> LIE_21 LIE_22 LIE_23 LIE_24 LIE_25
> 0.00 0.00 0.00 0.00 0.00
> LIE_26 LIE_27 LIE_28 LIE_29 LIE_30
> 0.00 0.00 0.00 0.00 0.00
> LIE_31 LIE_32 LIE_33 LIE_34 LIE_35
> 0.00 0.00 0.00 0.00 0.00
> LIE_36 LIE_37 LIE_38 LIE_39 LIE_40
> 0.02 0.01 0.01 0.00 0.00
> LIE_41 LIE_42 LIE_43 LIE_44 group_indices
> 0.01 0.00 0.00 0.00 1.00
> Intraclass Correlation 2 (Reliability of group differences)
> LIE_1 LIE_2 LIE_3 LIE_4 LIE_5
> 5.0e-02 -7.0e+01 -4.9e+01 -1.3e+00 9.2e-01
> LIE_6 LIE_7 LIE_8 LIE_9 LIE_10
> 7.1e-01 3.9e-01 -3.0e-01 -8.0e+00 -5.6e+05
> LIE_11 LIE_12 LIE_13 LIE_14 LIE_15
> -4.1e+01 -1.1e+02 -2.2e+01 -7.8e+00 0.0e+00
> LIE_16 LIE_17 LIE_18 LIE_19 LIE_20
> 2.3e-01 -1.1e+00 -2.0e+01 3.5e-01 2.4e-01
> LIE_21 LIE_22 LIE_23 LIE_24 LIE_25
> -4.6e-01 -4.1e+00 5.0e-01 -4.4e+02 4.4e-01
> LIE_26 LIE_27 LIE_28 LIE_29 LIE_30
> 6.0e-01 -3.1e+01 -8.2e+00 6.4e-01 -1.1e+00
> LIE_31 LIE_32 LIE_33 LIE_34 LIE_35
> -2.9e+02 -4.9e+01 1.1e-01 3.3e-01 5.5e-01
> LIE_36 LIE_37 LIE_38 LIE_39 LIE_40
> 8.9e-01 7.2e-01 6.8e-01 0.0e+00 -5.4e+00
> LIE_41 LIE_42 LIE_43 LIE_44 group_indices
> 6.8e-01 -6.9e+00 -3.8e+00 4.5e-01 1.0e+00
> eta^2 between groups
> LIE_1.bg LIE_2.bg LIE_3.bg LIE_4.bg LIE_5.bg LIE_6.bg LIE_7.bg LIE_8.bg
> 0.00 0.00 0.00 0.00 0.02 0.00 0.00 0.00
> LIE_9.bg LIE_10.bg LIE_11.bg LIE_12.bg LIE_13.bg LIE_14.bg LIE_15.bg LIE_16.bg
> 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
> LIE_17.bg LIE_18.bg LIE_19.bg LIE_20.bg LIE_21.bg LIE_22.bg LIE_23.bg LIE_24.bg
> 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
> LIE_25.bg LIE_26.bg LIE_27.bg LIE_28.bg LIE_29.bg LIE_30.bg LIE_31.bg LIE_32.bg
> 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
> LIE_33.bg LIE_34.bg LIE_35.bg LIE_36.bg LIE_37.bg LIE_38.bg LIE_39.bg LIE_40.bg
> 0.00 0.00 0.00 0.01 0.00 0.00 0.00 0.00
> LIE_41.bg LIE_42.bg LIE_43.bg LIE_44.bg
> 0.00 0.00 0.00 0.00
>
> To see the correlations between and within groups, use the short=FALSE option in your print statement.
> Many results are not shown directly. To see specific objects select from the following list:
> mean sd n F ICC1 ICC2 ci1 ci2 raw rbg pbg rwg nw ci.wg pwg etabg etawg nwg nG CallFactor structure quality
parameters::check_factorstructure(lie_EFA)> # Is the data suitable for Factor Analysis?
>
> - KMO: The Kaiser, Meyer, Olkin (KMO) measure of sampling adequacy suggests that data seems appropriate for factor analysis (KMO = 0.93).
> - Sphericity: Bartlett's test of sphericity suggests that there is sufficient significant correlation in the data for factor analysis (Chisq(946) = 9653.38, p < .001).Correlation matrix
cor <- as.matrix(correlation::correlation(lie_EFA))How many factors
parameters::n_factors(lie_EFA, cor = cor, rotation = "varimax", package = "all", safe = FALSE) %T>%
print() %>%
plot() +
ggtitle("How many factors to retain (Pearson's correlations)") +
theme_modern()> # Method Agreement Procedure:
>
> The choice of 4 dimensions is supported by 5 (20.00%) methods out of 25 (beta, EGA (TMFG), Velicer's MAP, BIC, BIC).
Exploratory Factor Analysis (EFA)
Four latent factors model
efa_4 <- psych::fa(cor, n.obs = nrow(lie_EFA), nfactors = 4, rotate = "varimax", fm = "ml")
parameters::model_parameters(efa_4, labels = labels_lie$Description) %>%
print(sort = TRUE, threshold = "max") > # Rotated loadings from Factor Analysis (varimax-rotation)
>
> Variable | Label | ML2 | ML1 | ML4 | ML3 | Complexity | Uniqueness
> ------------------------------------------------------------------------------------------------------------------------------
> LIE_4 | I have a tendency to lie | 0.75 | | | | 1.23 | 0.38
> LIE_23 | I find it difficult to refrain myself from lying | 0.73 | | | | 1.13 | 0.44
> LIE_5 | I lie more often than most people do | 0.73 | | | | 1.34 | 0.39
> LIE_1 | I lie frequently | 0.70 | | | | 1.61 | 0.36
> LIE_22 | I find myself lying without any reason | 0.68 | | | | 1.11 | 0.51
> LIE_7 | I lie more than I think I should | 0.67 | | | | 1.06 | 0.54
> LIE_6 | I lie more frequently than what I expect myself to | 0.65 | | | | 1.14 | 0.55
> LIE_2 | I lie in many situations | 0.61 | | | | 1.81 | 0.47
> LIE_26 | I enjoy lying | 0.59 | | | | 1.66 | 0.54
> LIE_8 | Others lie less often than I do | 0.53 | | | | 1.23 | 0.69
> LIE_29 | I lie whenever it’s convenient | 0.49 | | | | 2.10 | 0.64
> LIE_21 | I have to try hard to avoid lying | 0.45 | | | | 1.16 | 0.78
> LIE_31 | I lie if it’s the most direct way to get what I want | 0.44 | | | | 2.15 | 0.69
> LIE_28 | I feel satisfied when others believe my lie | 0.36 | | | | 2.99 | 0.71
> LIE_24 | It is easy to hold back from telling lies | -0.29 | | | | 1.83 | 0.88
> LIE_10 | I can lie well | | 0.82 | | | 1.39 | 0.20
> LIE_9 | I am a good liar | | 0.75 | | | 1.56 | 0.29
> LIE_18 | It is easy for me to make up clever lies | | 0.73 | | | 1.38 | 0.37
> LIE_14 | It is hard for others to detect my lies | | 0.73 | | | 1.22 | 0.42
> LIE_11 | I am good at deceiving others | | 0.71 | | | 1.56 | 0.36
> LIE_13 | Others can easily tell when I’m lying | | -0.69 | | | 1.22 | 0.48
> LIE_12 | I can lie effectively if I want to | | 0.67 | | | 1.42 | 0.46
> LIE_17 | I find lying difficult | | -0.67 | | | 1.82 | 0.36
> LIE_15 | I almost never get caught lying | | 0.65 | | | 1.36 | 0.50
> LIE_20 | I do not have to prepare much for a lie | | 0.58 | | | 1.58 | 0.58
> LIE_19 | I find it taxing to come up with a good lie | | -0.49 | | | 1.90 | 0.62
> LIE_27 | I feel tense whenever I have to lie | | -0.49 | | | 2.00 | 0.56
> LIE_16 | My lies often arouse suspicion from others | | -0.46 | | | 2.01 | 0.68
> LIE_41 | Lying is against my principles | | | 0.62 | | 1.69 | 0.49
> LIE_34 | I always avoid lying if I can | | | 0.57 | | 1.85 | 0.51
> LIE_44 | It is bad to lie | | | 0.55 | | 1.62 | 0.61
> LIE_25 | I feel guilty after lying | | | 0.54 | | 1.69 | 0.60
> LIE_36 | I prefer to tell the truth even if it gets me into trouble | | | 0.46 | | 1.69 | 0.71
> LIE_35 | I would only lie if I have no other choice | | | 0.36 | | 2.22 | 0.75
> LIE_37 | I would never lie for trivial matters | | | 0.34 | | 1.42 | 0.86
> LIE_38 | I would never lie in serious contexts | | | 0.31 | | 1.46 | 0.88
> LIE_43 | It is okay to lie sometimes | | | | 0.71 | 1.30 | 0.42
> LIE_33 | I lie when necessary | | | | 0.69 | 1.17 | 0.48
> LIE_42 | It is acceptable to lie depending on the context | | | | 0.62 | 1.38 | 0.54
> LIE_39 | I would lie if something important was at stake | | | | 0.47 | 1.30 | 0.74
> LIE_40 | I would only lie if it is harmless | | | | 0.46 | 1.20 | 0.77
> LIE_30 | I lie when it’s easier than telling the truth | | | | 0.38 | 2.07 | 0.75
> LIE_32 | I lie when telling the truth is too troublesome | | | | 0.38 | 2.29 | 0.73
> LIE_3 | I never tell lies | | | | -0.32 | 2.33 | 0.81
>
> The 4 latent factors (varimax rotation) accounted for 43.00% of the total variance of the original data (ML2 = 14.42%, ML1 = 14.41%, ML4 = 7.18%, ML3 = 6.98%).One latent factors model
efa_1 <- psych::fa(cor, n.obs = nrow(lie_EFA), nfactors = 1, rotate = "varimax", fm = "ml")
parameters::model_parameters(efa_1, labels = labels_lie$Description) %>%
print(sort = TRUE, threshold = "max") > # Rotated loadings from Factor Analysis (varimax-rotation)
>
> Variable | Label | ML1 | Complexity | Uniqueness
> -------------------------------------------------------------------------------------------------------
> LIE_10 | I can lie well | 0.83 | 1.00 | 0.31
> LIE_9 | I am a good liar | 0.81 | 1.00 | 0.34
> LIE_11 | I am good at deceiving others | 0.77 | 1.00 | 0.41
> LIE_18 | It is easy for me to make up clever lies | 0.75 | 1.00 | 0.44
> LIE_17 | I find lying difficult | -0.71 | 1.00 | 0.50
> LIE_14 | It is hard for others to detect my lies | 0.67 | 1.00 | 0.55
> LIE_12 | I can lie effectively if I want to | 0.64 | 1.00 | 0.59
> LIE_20 | I do not have to prepare much for a lie | 0.63 | 1.00 | 0.60
> LIE_1 | I lie frequently | 0.62 | 1.00 | 0.61
> LIE_15 | I almost never get caught lying | 0.62 | 1.00 | 0.62
> LIE_2 | I lie in many situations | 0.58 | 1.00 | 0.66
> LIE_4 | I have a tendency to lie | 0.57 | 1.00 | 0.67
> LIE_5 | I lie more often than most people do | 0.57 | 1.00 | 0.68
> LIE_26 | I enjoy lying | 0.55 | 1.00 | 0.70
> LIE_13 | Others can easily tell when I’m lying | -0.53 | 1.00 | 0.72
> LIE_41 | Lying is against my principles | -0.53 | 1.00 | 0.72
> LIE_27 | I feel tense whenever I have to lie | -0.51 | 1.00 | 0.73
> LIE_29 | I lie whenever it’s convenient | 0.51 | 1.00 | 0.74
> LIE_19 | I find it taxing to come up with a good lie | -0.50 | 1.00 | 0.75
> LIE_23 | I find it difficult to refrain myself from lying | 0.49 | 1.00 | 0.76
> LIE_28 | I feel satisfied when others believe my lie | 0.49 | 1.00 | 0.76
> LIE_25 | I feel guilty after lying | -0.47 | 1.00 | 0.78
> LIE_6 | I lie more frequently than what I expect myself to | 0.46 | 1.00 | 0.79
> LIE_44 | It is bad to lie | -0.45 | 1.00 | 0.80
> LIE_31 | I lie if it’s the most direct way to get what I want | 0.44 | 1.00 | 0.81
> LIE_22 | I find myself lying without any reason | 0.44 | 1.00 | 0.81
> LIE_43 | It is okay to lie sometimes | 0.42 | 1.00 | 0.83
> LIE_34 | I always avoid lying if I can | -0.42 | 1.00 | 0.83
> LIE_8 | Others lie less often than I do | 0.41 | 1.00 | 0.83
> LIE_7 | I lie more than I think I should | 0.40 | 1.00 | 0.84
> LIE_42 | It is acceptable to lie depending on the context | 0.40 | 1.00 | 0.84
> LIE_36 | I prefer to tell the truth even if it gets me into trouble | -0.39 | 1.00 | 0.85
> LIE_33 | I lie when necessary | 0.37 | 1.00 | 0.86
> LIE_32 | I lie when telling the truth is too troublesome | 0.33 | 1.00 | 0.89
> LIE_30 | I lie when it’s easier than telling the truth | 0.33 | 1.00 | 0.89
> LIE_16 | My lies often arouse suspicion from others | -0.26 | 1.00 | 0.93
> LIE_3 | I never tell lies | -0.26 | 1.00 | 0.93
> LIE_39 | I would lie if something important was at stake | 0.25 | 1.00 | 0.94
> LIE_38 | I would never lie in serious contexts | -0.24 | 1.00 | 0.94
> LIE_37 | I would never lie for trivial matters | -0.21 | 1.00 | 0.96
> LIE_21 | I have to try hard to avoid lying | 0.14 | 1.00 | 0.98
> LIE_40 | I would only lie if it is harmless | 0.14 | 1.00 | 0.98
> LIE_24 | It is easy to hold back from telling lies | -0.11 | 1.00 | 0.99
> LIE_35 | I would only lie if I have no other choice | -0.08 | 1.00 | 0.99
>
> The unique latent factor (varimax rotation) accounted for 24.63% of the total variance of the original data.paste0("The model with one, and four factors accounted for ",
report::format_text(c(insight::format_value(efa_1$Vaccounted[2,]*100),
insight::format_value(efa_4$Vaccounted[3, 4]*100))),
"% of variance of the dataset.")> [1] "The model with one, and four factors accounted for 24.63 and 43.00% of variance of the dataset."The factor number exploration suggested the presence of four and one latent factor(s). We therefore decided to keep the unique and four-factors models and submitted their simple structure to Confirmatory Factor Analysis (CFA)
Confirmatory Factor Analysis (CFA)
Model Selection
report_cfa_indices <- function(comparison, row=1, name="<model>"){
paste0("(X2", name, " = ", insight::format_value(comparison[row, "Chisq"]),
", AIC", name, " = ", insight::format_value(comparison[row, "AIC"]),
", BIC", name, " = ", insight::format_value(comparison[row, "BIC_adjusted"]),
", RMSEA", name, " = ", insight::format_value(comparison[row, "RMSEA"]),
", CFI", name, " = ", insight::format_value(comparison[row, "CFI"]),
", SRMR", name, " = ", insight::format_value(comparison[row, "SRMR"]),
")")
}One vs. Four Factors
cfa_4 <- parameters::efa_to_cfa(efa_4, threshold = "max") %>%
lavaan::cfa(data = lie_CFA)
cfa_1 <- parameters::efa_to_cfa(efa_1, threshold = "max") %>%
lavaan::cfa(data = lie_CFA)comparison_4vs1 <- performance::compare_performance(cfa_4, cfa_1) %>%
select(Model, AIC, BIC, BIC_adjusted, Chi2, RMSEA, CFI, SRMR)
display(comparison_4vs1)| Model | AIC | BIC | BIC_adjusted | Chi2 | RMSEA | CFI | SRMR |
|---|---|---|---|---|---|---|---|
| cfa_4 | 57650.70 | 58000.41 | 57702.29 | 2142.55 | 0.07 | 0.82 | 0.09 |
| cfa_1 | 59691.09 | 60018.48 | 59739.39 | 4194.94 | 0.11 | 0.53 | 0.12 |
The confirmatory factor analysis favoured the four-factors solution over the one-factor solution.
Four-factors vs. Initial Model
# Initial Model
model_initial <- c()
for (dimension in unique(labels_lie$Dimension)) {
model_initial <- c(
model_initial,
paste0(tools::toTitleCase(dimension), " =~ ", paste(as.character(labels_lie[labels_lie$Dimension == dimension, "Item"]), collapse = " + "))
)
}
cfa_initial <- paste0(model_initial, collapse = "\n") %>%
lavaan::cfa(data = lie_CFA)comparison_4vsinitial <- performance::compare_performance(cfa_4, cfa_initial) %>%
select(Model, AIC, BIC, BIC_adjusted, Chi2, RMSEA, CFI, SRMR)
display(comparison_4vsinitial)| Model | AIC | BIC | BIC_adjusted | Chi2 | RMSEA | CFI | SRMR |
|---|---|---|---|---|---|---|---|
| cfa_4 | 57650.70 | 58000.41 | 57702.29 | 2142.55 | 0.07 | 0.82 | 0.09 |
| cfa_initial | 58197.46 | 58536.01 | 58247.40 | 2695.31 | 0.08 | 0.74 | 0.10 |
We then compared the four-factors solution with the initial hypothetic model with which we built the scale, which favoured the four-factors model
Short vs. Long Form
cfa_4_short3 <- parameters::efa_to_cfa(efa_4, threshold = 3, names = c( "Frequency", "Ability", "Negativity", "Contextuality")) %>%
lavaan::cfa(data = lie_CFA)
cfa_4_short4 <- parameters::efa_to_cfa(efa_4, threshold = 4, names = c( "Frequency", "Ability", "Negativity", "Contextuality")) %>%
lavaan::cfa(data = lie_CFA)
cfa_4_short5 <- parameters::efa_to_cfa(efa_4, threshold = 5, names = c( "Frequency", "Ability", "Negativity", "Contextuality")) %>%
lavaan::cfa(data = lie_CFA)comparison_4vs4short <- performance::compare_performance(cfa_4, cfa_4_short3, cfa_4_short4, cfa_4_short5) %>%
select(Model, AIC, BIC, BIC_adjusted, Chi2, RMSEA, CFI, SRMR)
display(comparison_4vs4short)| Model | AIC | BIC | BIC_adjusted | Chi2 | RMSEA | CFI | SRMR |
|---|---|---|---|---|---|---|---|
| cfa_4 | 57650.70 | 58000.41 | 57702.29 | 2142.55 | 0.07 | 0.82 | 0.09 |
| cfa_4_short3 | 15296.48 | 15408.09 | 15312.94 | 117.05 | 0.07 | 0.96 | 0.06 |
| cfa_4_short4 | 20309.91 | 20451.28 | 20330.76 | 223.80 | 0.06 | 0.95 | 0.06 |
| cfa_4_short5 | 25408.64 | 25579.78 | 25433.89 | 322.18 | 0.06 | 0.95 | 0.06 |
| cfa_4 | 15296.48 | 15408.09 | |||||
| cfa_4_short3 | 20309.91 | 20451.28 | |||||
| cfa_4_short4 | 25408.64 | 25579.78 | |||||
| cfa_4_short5 | 57650.70 | 58000.41 |
Finally, we compared the full four-factors model (including all items) with short form retaining only the 3, 4 or 5 most loading items for each of the 4 dimensions. The 3-items version outperformed all versions, including 5-items and 4-items. Nonetheless, as 3-items per construct is the bare minimum for adequate reliability, we decided to keep the second best performing version with 4-items per factor, which also displayed excellent indices of fit.
table_comparison <- distinct(bind_rows(
as.data.frame(comparison_4vs1),
as.data.frame(comparison_4vsinitial),
as.data.frame(comparison_4vs4short)
)) %>%
mutate(Model = case_when(
Model == "cfa_4" ~ "Four Factors: all items",
Model == "cfa_1" ~ "One Factor: all items",
Model == "cfa_initial" ~ "Hypothesized: all items",
Model == "cfa_4_short3" ~ "Four Factors: 3 items",
Model == "cfa_4_short4" ~ "Four Factors: 4 items",
Model == "cfa_4_short5" ~ "Four Factors: 5 items"
))
write.csv(table_comparison, "figures/table_comparison.csv", row.names = FALSE)Model Description
# Refit the cfa model with the full sample
cfa_4_short4_full <- parameters::efa_to_cfa(efa_4, threshold = 4, names = c( "Frequency", "Ability", "Negativity", "Contextuality")) %>%
lavaan::cfa(data = lie)
cfa_parameters <- model_parameters(cfa_4_short4_full, standardize = FALSE)
cfa_parameters| To | Operator | From | Coefficient | SE | CI_low | CI_high | p | Type | |
|---|---|---|---|---|---|---|---|---|---|
| 1 | Frequency | =~ | LIE_1 | 1.00 | 0.00 | 1.00 | 1.00 | 0 | Loading |
| 2 | Frequency | =~ | LIE_4 | 1.01 | 0.04 | 0.93 | 1.09 | 0 | Loading |
| 3 | Frequency | =~ | LIE_5 | 0.92 | 0.04 | 0.85 | 1.00 | 0 | Loading |
| 4 | Frequency | =~ | LIE_23 | 0.82 | 0.04 | 0.74 | 0.90 | 0 | Loading |
| 5 | Ability | =~ | LIE_9 | 1.00 | 0.00 | 1.00 | 1.00 | 0 | Loading |
| 6 | Ability | =~ | LIE_10 | 1.05 | 0.03 | 0.99 | 1.10 | 0 | Loading |
| 7 | Ability | =~ | LIE_14 | 0.77 | 0.03 | 0.71 | 0.83 | 0 | Loading |
| 8 | Ability | =~ | LIE_18 | 0.87 | 0.03 | 0.81 | 0.94 | 0 | Loading |
| 9 | Negativity | =~ | LIE_25 | 1.00 | 0.00 | 1.00 | 1.00 | 0 | Loading |
| 10 | Negativity | =~ | LIE_34 | 0.86 | 0.06 | 0.73 | 0.99 | 0 | Loading |
| 11 | Negativity | =~ | LIE_41 | 1.30 | 0.09 | 1.12 | 1.48 | 0 | Loading |
| 12 | Negativity | =~ | LIE_44 | 1.07 | 0.08 | 0.91 | 1.22 | 0 | Loading |
| 13 | Contextuality | =~ | LIE_33 | 1.00 | 0.00 | 1.00 | 1.00 | 0 | Loading |
| 14 | Contextuality | =~ | LIE_39 | 0.78 | 0.07 | 0.64 | 0.92 | 0 | Loading |
| 15 | Contextuality | =~ | LIE_42 | 1.03 | 0.07 | 0.90 | 1.16 | 0 | Loading |
| 16 | Contextuality | =~ | LIE_43 | 1.21 | 0.07 | 1.06 | 1.35 | 0 | Loading |
| 37 | Frequency | ~~ | Ability | 2.30 | 0.22 | 1.87 | 2.74 | 0 | Correlation |
| 38 | Frequency | ~~ | Negativity | -1.78 | 0.18 | -2.13 | -1.44 | 0 | Correlation |
| 39 | Frequency | ~~ | Contextuality | 0.79 | 0.14 | 0.52 | 1.06 | 0 | Correlation |
| 40 | Ability | ~~ | Negativity | -1.74 | 0.19 | -2.12 | -1.37 | 0 | Correlation |
| 41 | Ability | ~~ | Contextuality | 1.59 | 0.18 | 1.24 | 1.94 | 0 | Correlation |
| 42 | Negativity | ~~ | Contextuality | -0.88 | 0.12 | -1.12 | -0.64 | 0 | Correlation |
data <- see::data_plot(cfa_parameters, ci=FALSE)
data$nodes <- mutate(data$nodes, Name = stringr::str_replace(Name, "LIE_", "Q"))
data$edges <- mutate(data$edges, from = stringr::str_replace(from, "LIE_", "Q"))
p <- tidygraph::tbl_graph(data$nodes, data$edges) %>%
ggraph::ggraph(layout = 'fr') +
ggraph::geom_edge_arc(aes(alpha = as.numeric(Type == "Correlation"),
label = Label_Correlation,
color = Coefficient),
strength = 0.1,
edge_width = 1.5,
label_dodge = unit(2, "mm"),
linetype = 1, angle_calc = "along",
label_size = 3,
start_cap = ggraph::circle(0, 'mm'), end_cap = ggraph::circle(0, 'mm')) +
ggraph::geom_edge_link(aes(alpha = as.numeric(Type == "Loading"),
label = Label_Loading,
color = Coefficient),
label_dodge = unit(2, "mm"),
angle_calc = "along",
edge_width = 0.9,
label_size = 3,
check_overlap = TRUE,
arrow = arrow(type = "closed", length = unit(3, "mm")),
start_cap = ggraph::circle(0, 'mm'), end_cap = ggraph::circle(-12, 'mm')) +
ggraph::geom_node_point(aes(colour = Name, size = Latent)) +
ggraph::geom_node_text(aes(label = Name)) +
ggraph::scale_edge_colour_gradient2(
guide = FALSE,
high = "#4CAF50",
mid = "#FFF9C4",
low = "#E91E63"
) +
scale_alpha(guide = FALSE, range = c(0, 1)) +
scale_size_manual(values=c("TRUE"=33, "FALSE"=22)) +
scale_color_manual(values=c("Negativity"="#E91E63", "Q41"="#EC407A", "Q44"="#F06292", "Q34"="#F48FB1", "Q25"="#F8BBD0",
"Contextuality"="#FF9800", "Q43"="#FFA726", "Q42"="#FFB74D", "Q33"="#FFCC80", "Q39"="#FFE0B2",
"Frequency"="#4CAF50", "Q1"="#66BB6A", "Q4"="#81C784", "Q5"="#A5D6A7", "Q23"="#C8E6C9",
"Ability"="#2196F3", "Q10"="#42A5F5", "Q9"="#64B5F6", "Q18"="#90CAF9", "Q14"="#BBDEFB")) +
ggraph::scale_edge_alpha(guide = FALSE, range = c(0, 1)) +
scale_x_continuous(expand = expand_scale(c(0.07, 0.07))) +
scale_y_continuous(expand = expand_scale(c(0.07, 0.07))) +
ggraph::theme_graph() +
theme(legend.position = "none")
ggsave("figures/figure_CFA.png", p, height=figwidth*0.8, width=figwidth*0.8)Loadings Table
table_efa <- as.data.frame(sort(parameters::model_parameters(efa_4, labels = labels_lie$Description)))[,1:6] %>%
mutate(Variable = as.character(Variable)) %>%
mutate_if(is.numeric, insight::format_value)
names(table_efa) <- c("Item", "Label", "Frequency", "Ability", "Negativity", "Contextuality")
table_cfa <- as.data.frame(parameters::model_parameters(cfa_4_short4_full)) %>%
filter(Type == "Loading") %>%
select(To, Item=From, Coefficient) %>%
pivot_wider(names_from=To, values_from=Coefficient, names_prefix="CFA_") %>%
mutate(Item = as.character(Item))
table <- full_join(table_efa, table_cfa, by="Item") %>%
mutate_if(is.numeric, insight::format_value) %>%
mutate(Frequency = paste0(Frequency, " [", CFA_Frequency, "]"),
Ability = paste0(Ability, " [", CFA_Ability, "]"),
Negativity = paste0(Negativity, " [", CFA_Negativity, "]"),
Contextuality = paste0(Contextuality, " [", CFA_Contextuality, "]"),
Item = stringr::str_replace(Item, "LIE_", "Q")) %>%
mutate_all(function(x) stringr::str_remove_all(x, " \\[]")) %>%
select(Item, Label, Frequency, Ability, Negativity, Contextuality)
write.csv(table, "figures/table_loadings.csv", row.names = FALSE)Compute Scores
lie <- predict(cfa_parameters)
names(lie) <- paste0("LIE_", names(lie))lie %>%
select(starts_with("LIE_")) %>%
report() %>%
as.data.frame() %>%
select(-one_of(c("n_Obs", "Median", "MAD", "n_Missing"))) %>%
print()> Variable | Mean | SD | Min | Max | Skewness | Kurtosis | percentage_Missing
> ----------------------------------------------------------------------------------------------
> LIE_Frequency | 1.80e-17 | 1.86 | -3.24 | 5.34 | 0.26 | -0.65 | 0.00
> LIE_Ability | -5.60e-17 | 2.33 | -5.12 | 4.71 | -0.32 | -0.74 | 0.00
> LIE_Negativity | -1.48e-18 | 1.32 | -4.44 | 2.87 | -0.08 | -0.31 | 0.00
> LIE_Contextuality | 1.62e-17 | 1.34 | -5.17 | 2.60 | -0.89 | 1.38 | 0.00p_distrib <- lie %>%
select(starts_with("LIE_")) %>%
dplyr::rename_all(.funs = list(~ sub("LIE_*", "", .))) %>%
bayestestR::estimate_density(method = "KernSmooth") %>%
see::data_plot() %>%
mutate(Parameter = fct_relevel(Parameter, "Frequency", "Ability", "Negativity", "Contextuality")) %>%
ggplot(aes(x=x, y=y, color=Parameter)) +
geom_line(size=2) +
# ggtitle("Distribution of the LIE dimensions") +
xlab("Score\n") +
ylab("Distribution") +
theme_modern() +
scale_color_manual(values=c("Frequency"= "#2196F3", "Ability"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions")Reliability
Cronbach’s alpha
paste0("All subscales of the LIE scale, namely, Frequency (alpha = ",
insight::format_value(performance::cronbachs_alpha(select(df, LIE_1, LIE_4, LIE_5, LIE_23))),
"), Ability (alpha = ",
insight::format_value(performance::cronbachs_alpha(select(df, LIE_9, LIE_10, LIE_14, LIE_18))),
"), Contextuality (alpha = ",
insight::format_value(performance::cronbachs_alpha(select(df, LIE_33, LIE_39, LIE_42, LIE_43))),
") and Negativity (alpha = ",
insight::format_value(performance::cronbachs_alpha(select(df, LIE_25, LIE_34, LIE_41, LIE_44))),
") have a high reliability.")> [1] "All subscales of the LIE scale, namely, Frequency (alpha = 0.86), Ability (alpha = 0.90), Contextuality (alpha = 0.75) and Negativity (alpha = 0.75) have a high reliability."# library(formattable)
questions <- dplyr::select(df, dplyr::one_of(row.names(lavaan::lavInspect(cfa_4_short4_full)$lambda)))
om <- psych::omega(m = questions, nfactors = 4, fm = "ml", title = "Omega of LIE Scale", plot = "FALSE", n.obs = nrow(questions), flip=FALSE) # ωh = 0.36, ωt = 0.83
# Table of omega coefficients
table_om <- om$omega.group
rownames(table_om) <- c("All items","Frequency", "Ability", "Negativity", "Contextuality")
colnames(table_om) <- c("Omega (total)", "Omega (hierarchical)", "Omega (group)")
table_om| Omega (total) | Omega (hierarchical) | Omega (group) | |
|---|---|---|---|
| All items | 0.83 | 0.36 | 0.50 |
| Frequency | 0.91 | 0.44 | 0.47 |
| Ability | 0.87 | 0.37 | 0.50 |
| Negativity | 0.76 | 0.19 | 0.57 |
| Contextuality | 0.75 | 0.37 | 0.38 |
# Table of variance accounted for
table_variance <- om$omega.group %>%
mutate(Composite = c("All items", "Frequency", "Ability", "Negativity", "Contextuality")) %>%
mutate(Total = total*100,
General = general*100,
Group = group*100) %>%
select(Composite, Total, General, Group)
colnames(table_variance) <- c("Composite", "Total Variance (%)", "Variance due to General Factor (%)", "Variance due to Group Factor (%)")
table_variance | Composite | Total Variance (%) | Variance due to General Factor (%) | Variance due to Group Factor (%) |
|---|---|---|---|
| All items | 83 | 36 | 50 |
| Frequency | 91 | 44 | 47 |
| Ability | 87 | 37 | 50 |
| Negativity | 76 | 19 | 57 |
| Contextuality | 75 | 37 | 38 |
psych::cor.plot(om)
Cluster Structure
Cluster Tendency
parameters::check_clusterstructure(lie, standardize = FALSE) %T>%
print() %>%
plot()> # Clustering tendency
>
> The dataset is suitable for clustering (Hopkins' H = 0.24).
How many clusters
parameters::n_clusters(lie, standardize = FALSE) %T>%
print() %>%
plot() +
theme_modern()> # Method Agreement Procedure:
>
> The choice of 3 clusters is supported by 11 (39.29%) methods out of 28 (KL, Hartigan, Scott, Marriot, TrCovW, TraceW, Friedman, Rubin, Ball, PtBiserial, Mixture).
The agreement procedure, combining 28 different methods for determining the optimal number of clusters, supported the existence of 2 (8/28) or 3 (11/28) clusters.
Clustering
K-means
set.seed(333)
k2 <- kmeans(lie, centers=2, iter.max = 10000, nstart = 1000)
k3 <- kmeans(lie, centers=3, iter.max = 10000, nstart = 1000)
model_parameters(k2) | Cluster | n_Obs | Sum_Squares | LIE_Frequency | LIE_Ability | LIE_Negativity | LIE_Contextuality |
|---|---|---|---|---|---|---|
| 1 | 310 | 2256 | -1.42 | -2.1 | 0.97 | -0.74 |
| 2 | 452 | 2947 | 0.97 | 1.5 | -0.67 | 0.50 |
model_parameters(k3) | Cluster | n_Obs | Sum_Squares | LIE_Frequency | LIE_Ability | LIE_Negativity | LIE_Contextuality |
|---|---|---|---|---|---|---|
| 1 | 319 | 1711 | -0.53 | 0.19 | 0.15 | 0.11 |
| 2 | 267 | 1317 | 1.85 | 1.92 | -1.09 | 0.61 |
| 3 | 176 | 979 | -1.85 | -3.25 | 1.38 | -1.13 |
paste0("We applied k-means clustering, which revealed that grouping the participants in 2 and 3 clusters would account for ",
insight::format_value(attributes(model_parameters(k2))$variance*100),
"% and ",
insight::format_value(attributes(model_parameters(k3))$variance*100),
"% of the total variance of the four dimensions of the questionnaire, respectively.",
" Thus, we decided to go ahead with the latter solution.")> [1] "We applied k-means clustering, which revealed that grouping the participants in 2 and 3 clusters would account for 44.92% and 57.58% of the total variance of the four dimensions of the questionnaire, respectively. Thus, we decided to go ahead with the latter solution."Compute Profiles
lie$LIE_Profile <- model_parameters(k3) %>%
predict(names = c("Average", "Trickster", "Virtuous"))
paste0('We then assigned each participant to its nearest cluster, labelling them as Average (',
insight::format_value(sum(lie$LIE_Profile=="Average")/nrow(lie)*100),
"% of the sample; people that report an average lying ability, slightly lower than average frequency, average negativity and contextuality), Trickster (",
insight::format_value(sum(lie$LIE_Profile=="Trickster")/nrow(lie)*100),
"%; people with high reported lying ability, frequency, low negative experience associated with deception and above-average flexibility in its implementation), and Virtuous (",
insight::format_value(sum(lie$LIE_Profile=="Virtuous")/nrow(lie)*100),
"%; people with very low reported lying ability and frequency, strong negative emotions and moral attitude associated with lying and high rigidity in their (non-)usage of deception).")> [1] "We then assigned each participant to its nearest cluster, labelling them as Average (41.86% of the sample; people that report an average lying ability, slightly lower than average frequency, average negativity and contextuality), Trickster (35.04%; people with high reported lying ability, frequency, low negative experience associated with deception and above-average flexibility in its implementation), and Virtuous (23.10%; people with very low reported lying ability and frequency, strong negative emotions and moral attitude associated with lying and high rigidity in their (non-)usage of deception)."Visualisation
colors_cluster <- c("Average" = "#D500F9", "Trickster" = "#F50057", "Virtuous" = "#3D5AFE")
p_profiles <- lie %>%
select(starts_with("LIE_")) %>%
pivot_longer(-LIE_Profile, names_to = "Dimension", values_to = "Score") %>%
mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous"),
Dimension = str_remove(Dimension, "LIE_"),
Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality")) %>%
group_by(LIE_Profile, Dimension) %>%
summarise_all(mean) %>%
rename(Profile = LIE_Profile) %>%
ggplot(aes(x = Dimension, y = Score, color = Profile, group = Profile)) +
geom_line(key_glyph = "label") +
geom_polygon(fill = NA, size = 2.5, show.legend = FALSE) +
scale_color_manual(values = colors_cluster) +
theme_minimal() +
xlab("") + ylab("") +
scale_y_continuous(breaks = c(-2, 0, 2), expand = expand_scale(c(.10, 0))) +
# scale_y_continuous(limits = c(-5, 5)) +
theme(axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
legend.title = element_text(face="bold", size=15),
panel.grid.major.y = element_line(color="#E0E0E0", linetype="longdash"),
panel.grid.major.x = element_blank(),
legend.text = element_text(size=13),
axis.text.x = element_text(
vjust = -0.5,
size = 13,
# face="bold",
color="black")) +
coord_radar(start = -pi/4, clip="off")# Combine plots
p <- cowplot::plot_grid(p_distrib, p_profiles, nrow=2, labels = c('A', 'B'), label_size = 14)
ggsave("figures/figure_dimensions.png", p, height=figheight, width=figwidth*0.9)Convergent Validity
df <- cbind(df, lie) %>%
select(-matches("LIE_\\d"))Demographics
Sex
library(rstanarm)
model_dimensional <- stan_glm(Sex ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity, data=df, family = "binomial", refresh = 0, seed=333)
model_profile <- stan_glm(Sex ~ LIE_Profile, data = df, family = "binomial", refresh = 0, seed=333)
performance::compare_performance(model_dimensional, model_profile, metrics = c("LOOIC", "R2"))| Model | Type | ELPD | ELPD_SE | LOOIC | LOOIC_SE | R2 |
|---|---|---|---|---|---|---|
| model_dimensional | stanreg | -516 | 5.8 | 1032 | 12 | 0.03 |
| model_profile | stanreg | -516 | 5.5 | 1031 | 11 | 0.03 |
parameters::parameters_table(model_parameters(model_profile))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior |
|---|---|---|---|---|---|---|---|
| (Intercept) | -0.28 | [-0.48, -0.11] | 99.55% | 18.27% | 1.000 | 3263.44 | Normal (0 +- 2.50) |
| LIE_ProfileTrickster | 0.41 | [ 0.13, 0.67] | 99.15% | 8.65% | 1.000 | 3160.38 | Normal (0 +- 5.24) |
| LIE_ProfileVirtuous | -0.48 | [-0.81, -0.19] | 99.38% | 5.97% | 0.999 | 3175.49 | Normal (0 +- 5.93) |
parameters::parameters_table(model_parameters(model_dimensional))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | -0.25 | [-0.37, -0.13] | 99.95% | 17.12% | 1.000 | 4012.38 | Normal (0 +- 2.50) |
| 2 | LIE_Ability | 0.14 | [ 0.07, 0.21] | 99.85% | 85.78% | 1.001 | 3114.18 | Normal (0 +- 1.08) |
| 4 | LIE_Frequency | 0.02 | [-0.07, 0.11] | 63.68% | 99.70% | 1.001 | 2445.17 | Normal (0 +- 1.34) |
| 3 | LIE_Contextuality | -0.04 | [-0.14, 0.07] | 70.62% | 98.00% | 1.000 | 3305.41 | Normal (0 +- 1.87) |
| 5 | LIE_Negativity | -0.06 | [-0.19, 0.08] | 74.08% | 92.38% | 1.002 | 2090.23 | Normal (0 +- 1.89) |
model_profile %>%
estimate_means() %>%
mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
ggplot(aes(x = LIE_Profile, y = Probability, color = LIE_Profile)) +
geom_line(aes(group = 1), size = 1) +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
theme_modern() +
scale_color_manual(values = colors_cluster, guide = FALSE) +
ylab("Probability of being a Male") +
xlab("Deception Profile")
df %>%
select(Participant, Sex, starts_with("LIE_"), -LIE_Profile) %>%
pivot_longer(-c(Sex, Participant), names_to = "Dimension", values_to = "Score") %>%
mutate(Dimension = str_remove(Dimension, "LIE_"),
Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality")) %>%
ggplot(aes(x = Dimension, y = Score)) +
geom_boxplot(aes(fill = Sex, color = Sex)) +
scale_fill_manual(values = c("Male" = "#2196F3", "Female" = "#F06292")) +
scale_color_manual(values = c("Male" = "#2196F3", "Female" = "#F06292")) +
theme_modern() +
coord_flip()
sig <- model_parameters(model_dimensional)[-1,] %>%
select(Parameter, pd) %>%
mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
Text = insight::format_pd(pd, stars_only=TRUE),
Predicted = 0.6,
Score = df %>%
select(one_of(Parameter)) %>%
summarise_all(function(x) {mean(range(x))}) %>%
t()) %>%
mutate(Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality"))
p_sex <- rbind(estimate_link(model_dimensional, target="LIE_Ability") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Frequency") %>%
mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Contextuality") %>%
mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Negativity") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
mutate(Dimension = str_remove(Dimension, "LIE_"),
Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality")) %>%
ggplot(aes(x = Score, y = Predicted)) +
geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
geom_line(aes(color=Dimension), size = 1) +
geom_text(data = sig, aes(label = Text)) +
theme_modern() +
theme(strip.placement = "outside",
strip.text = element_text(size=13, face="plain"),
axis.title = element_text(size=13),
axis.text = element_text(size=9),
plot.title = element_text(face="bold", hjust = 0.5)) +
ggtitle("Sex") +
ylab("Probability of being a Male") +
xlab("") +
scale_color_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
scale_fill_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")Age
model_dimensional <- stan_lmer(Age ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + Income + Education + (1|Sex), data = df, refresh = 0, seed=333)
model_profile <- stan_lmer(Age ~ LIE_Profile + Income + Education + (1|Sex), data = df, refresh = 0, seed=333)
performance::compare_performance(model_dimensional, model_profile)| Model | Type | ELPD | ELPD_SE | LOOIC | LOOIC_SE | WAIC | R2 | R2_marginal | R2_adjusted | RMSE | Sigma |
|---|---|---|---|---|---|---|---|---|---|---|---|
| model_dimensional | stanreg | -2194 | 37 | 4389 | 74 | 4389 | 0.26 | 0.26 | 0.23 | 6.7 | 6.7 |
| model_profile | stanreg | -2190 | 37 | 4381 | 74 | 4381 | 0.27 | 0.27 | 0.24 | 6.6 | 6.7 |
parameters::parameters_table(model_parameters(model_profile))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | 31.45 | [29.35, 33.53] | 100% | 0% | 1.003 | 677.60 | Normal (25.49 +- 19.39) |
| 4 | LIE_ProfileTrickster | -0.43 | [-1.37, 0.55] | 76.42% | 70.10% | 1.000 | 2547.36 | Normal (0.00 +- 40.55) |
| 5 | LIE_ProfileVirtuous | 2.81 | [ 1.68, 4.01] | 100% | 0.15% | 1.012 | 432.57 | Normal (0.00 +- 46.51) |
| 3 | Income | 1.81e-04 | [ 0.00, 0.00] | 99.80% | 100% | 1.001 | 3554.29 | Normal (0.00 +- 4.45e-03) |
| 2 | Education | -1.97 | [-2.18, -1.76] | 100% | 0% | 1.001 | 2231.96 | Normal (0.00 +- 9.71) |
parameters::parameters_table(model_parameters(model_dimensional))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | 31.75 | [26.74, 33.56] | 100% | 0% | 1.009 | 45.23 | Normal (25.49 +- 19.39) |
| 4 | LIE_Ability | -0.36 | [-0.60, -0.13] | 99.17% | 99.83% | 1.001 | 916.81 | Normal (0.00 +- 8.39) |
| 6 | LIE_Frequency | 6.87e-03 | [-0.25, 0.41] | 51.68% | 100% | 1.002 | 341.15 | Normal (0.00 +- 10.26) |
| 5 | LIE_Contextuality | -0.26 | [-0.62, 0.13] | 86.00% | 98.88% | 1.007 | 1194.04 | Normal (0.00 +- 14.46) |
| 7 | LIE_Negativity | 0.19 | [-0.29, 0.70] | 74.62% | 97.10% | 1.002 | 477.24 | Normal (0.00 +- 14.51) |
| 3 | Income | 1.80e-04 | [ 0.00, 0.00] | 99.75% | 100% | 1.015 | 306.85 | Normal (0.00 +- 4.45e-03) |
| 2 | Education | -1.92 | [-2.13, -1.70] | 100% | 0% | 1.007 | 531.72 | Normal (0.00 +- 9.71) |
model_profile %>%
estimate_means() %>%
mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
geom_line(aes(group = 1), size = 1) +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
theme_modern() +
scale_color_manual(values = colors_cluster, guide = FALSE) +
ylab("Age") +
xlab("Deception Profile")
sig <- model_parameters(model_dimensional)[2:5,] %>%
select(Parameter, pd) %>%
mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
Text = format_pd(pd, stars_only=TRUE),
Predicted = 29,
Score = df %>%
select(one_of(Parameter)) %>%
summarise_all(function(x) {mean(range(x))}) %>%
t()) %>%
mutate(Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality"))
p_age <- rbind(estimate_link(model_dimensional, target="LIE_Frequency") %>%
mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Ability") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Contextuality") %>%
mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Negativity") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
mutate(Dimension = str_remove(Dimension, "LIE_"),
Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality")) %>%
ggplot(aes(x = Score, y = Predicted)) +
geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
geom_line(aes(color=Dimension), size = 1) +
geom_text(data = sig, aes(label = Text)) +
theme_modern() +
theme(strip.placement = "outside",
strip.text = element_text(size=13, face="plain"),
axis.title = element_text(size=13),
axis.text = element_text(size=9),
plot.title = element_text(face="bold", hjust = 0.5)) +
ggtitle("Age") +
ylab("\nAge") +
xlab("") +
scale_color_manual(values=c("Frequency"="#4CAF50", "Ability"= "#2196F3", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
scale_fill_manual(values=c("Frequency"="#4CAF50", "Ability"= "#2196F3", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")Education
model_profile <- stan_lmer(Education ~ LIE_Profile + Age + (1|Sex), data = df, refresh = 0, seed=333)
model_dimensional <- stan_lmer(Education ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + Age + (1|Sex), data = df, refresh = 0, seed=333)
performance::compare_performance(model_dimensional, model_profile)| Model | Type | ELPD | ELPD_SE | LOOIC | LOOIC_SE | WAIC | R2 | R2_marginal | R2_adjusted | RMSE | Sigma |
|---|---|---|---|---|---|---|---|---|---|---|---|
| model_dimensional | stanreg | -1502 | 33 | 3005 | 65 | 3005 | 0.24 | 0.24 | 0.22 | 1.7 | 1.8 |
| model_profile | stanreg | -1499 | 33 | 2997 | 66 | 2997 | 0.25 | 0.25 | 0.23 | 1.7 | 1.7 |
parameters::parameters_table(model_parameters(model_profile))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | 6.75 | [ 6.07, 7.32] | 100% | 0% | 1.008 | 842.91 | Normal (3.51 +- 5.01) |
| 3 | LIE_ProfileTrickster | -0.36 | [-0.58, -0.12] | 99.52% | 13.70% | 1.000 | 2391.72 | Normal (0.00 +- 10.51) |
| 4 | LIE_ProfileVirtuous | 0.36 | [ 0.08, 0.61] | 98.62% | 15.65% | 1.000 | 2307.13 | Normal (0.00 +- 11.90) |
| 2 | Age | -0.13 | [-0.14, -0.11] | 100% | 100% | 1.001 | 2628.67 | Normal (0.00 +- 0.65) |
parameters::parameters_table(model_parameters(model_dimensional))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | 6.73 | [ 5.74, 8.25] | 100% | 0% | 1.732 | 8.87 | Normal (3.51 +- 5.01) |
| 3 | LIE_Ability | -0.07 | [-0.12, -0.01] | 94.50% | 99.98% | 1.098 | 44.35 | Normal (0.00 +- 2.16) |
| 5 | LIE_Frequency | -0.08 | [-0.16, 0.00] | 96.40% | 99.08% | 1.001 | 2072.94 | Normal (0.00 +- 2.69) |
| 4 | LIE_Contextuality | 0.06 | [-0.03, 0.15] | 82.33% | 99.58% | 1.071 | 61.39 | Normal (0.00 +- 3.75) |
| 6 | LIE_Negativity | 0.01 | [-0.10, 0.14] | 57.57% | 99.02% | 1.019 | 658.49 | Normal (0.00 +- 3.81) |
| 2 | Age | -0.12 | [-0.14, -0.11] | 100% | 100% | 1.122 | 37.06 | Normal (0.00 +- 0.65) |
model_profile %>%
estimate_means() %>%
mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
geom_line(aes(group = 1), size = 1) +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
theme_modern() +
scale_color_manual(values = colors_cluster, guide = FALSE) +
ylab("Education (in years)") +
xlab("Deception Profile")
Income
model_dimensional <- stan_lmer(Income ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + Age + Education + (1|Sex), data = df, refresh = 0, seed=333)
model_profile <- stan_lmer(Income ~ LIE_Profile + Age + Education + (1|Sex), data = df, refresh = 0, seed=333)
performance::compare_performance(model_dimensional, model_profile)| Model | Type | ELPD | ELPD_SE | LOOIC | LOOIC_SE | WAIC | R2 | R2_marginal | R2_adjusted | RMSE | Sigma |
|---|---|---|---|---|---|---|---|---|---|---|---|
| model_dimensional | stanreg | -6464 | 138 | 12928 | 277 | 12951 | 0.04 | 0.04 | 0.01 | 4276 | 4307 |
| model_profile | stanreg | -6468 | 142 | 12937 | 284 | 12950 | 0.04 | 0.04 | 0.01 | 4284 | 4302 |
parameters::parameters_table(model_parameters(model_profile))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | -764.71 | [-2488.52, 1151.07] | 75.40% | 25.97% | 1.009 | 677.57 | Normal (2806.25 +- 10895.43) |
| 4 | LIE_ProfileTrickster | 418.98 | [ -197.34, 1033.15] | 86.62% | 50.58% | 1.001 | 2800.34 | Normal (0.00 +- 22787.22) |
| 5 | LIE_ProfileVirtuous | -373.30 | [-1055.98, 381.52] | 79.83% | 51.70% | 1.001 | 2707.16 | Normal (0.00 +- 26137.92) |
| 2 | Age | 74.38 | [ 36.52, 118.91] | 99.92% | 100% | 1.000 | 2149.66 | Normal (0.00 +- 1404.88) |
| 3 | Education | 434.89 | [ 279.49, 584.29] | 100% | 50.32% | 1.000 | 2468.65 | Normal (0.00 +- 5456.14) |
parameters::parameters_table(model_parameters(model_dimensional))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | -620.75 | [-2367.14, 1347.68] | 73.25% | 26.97% | 1.003 | 1081.66 | Normal (2806.25 +- 10895.43) |
| 4 | LIE_Ability | 189.56 | [ 28.94, 342.75] | 97.12% | 99.67% | 1.001 | 2633.73 | Normal (0.00 +- 4714.92) |
| 6 | LIE_Frequency | 38.13 | [ -173.63, 239.24] | 60.92% | 99.88% | 1.000 | 2593.13 | Normal (0.00 +- 5763.34) |
| 5 | LIE_Contextuality | -165.66 | [ -389.59, 90.37] | 85.88% | 96.83% | 1.000 | 2905.98 | Normal (0.00 +- 8123.93) |
| 7 | LIE_Negativity | 16.91 | [ -282.01, 331.21] | 53.25% | 97.35% | 1.000 | 2615.01 | Normal (0.00 +- 8156.44) |
| 2 | Age | 74.16 | [ 33.21, 113.12] | 99.80% | 100% | 1.000 | 3135.67 | Normal (0.00 +- 1404.88) |
| 3 | Education | 436.76 | [ 279.41, 583.97] | 100% | 49.53% | 1.001 | 2656.01 | Normal (0.00 +- 5456.14) |
model_profile %>%
estimate_means() %>%
mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
geom_line(aes(group = 1), size = 1) +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
theme_modern() +
scale_color_manual(values = colors_cluster, guide = FALSE) +
ylab("Income") +
xlab("Deception Profile")
sig <- model_parameters(model_dimensional)[2:5,] %>%
select(Parameter, pd) %>%
mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
Text = format_pd(pd, stars_only=TRUE),
Predicted = 4500,
Score = df %>%
select(one_of(Parameter)) %>%
summarise_all(function(x) {mean(range(x))}) %>%
t()) %>%
mutate(Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality"))
p_income <- rbind(estimate_link(model_dimensional, target="LIE_Ability") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Frequency") %>%
mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Contextuality") %>%
mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Negativity") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
mutate(Dimension = str_remove(Dimension, "LIE_"),
Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality")) %>%
ggplot(aes(x = Score, y = Predicted)) +
geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
geom_line(aes(color=Dimension), size = 1) +
geom_text(data = sig, aes(label = Text)) +
theme_modern() +
theme(strip.placement = "outside",
strip.text = element_text(size=13, face="plain"),
axis.title = element_text(size=13),
axis.text = element_text(size=9),
plot.title = element_text(face="bold", hjust = 0.5)) +
ggtitle("Income") +
ylab("Income (in SGD per capita)") +
xlab("") +
scale_color_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
scale_fill_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")Religion
model_dimensional <- stan_lmer(Religion_Faith ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + (1|Religion_Type), data = dplyr::filter(df, !is.na(Religion_Faith)), refresh = 0, seed=333)
model_profile <- stan_lmer(Religion_Faith ~ LIE_Profile + (1|Religion_Type), data = dplyr::filter(df, !is.na(Religion_Faith)), refresh = 0, seed=333)
performance::compare_performance(model_dimensional, model_profile)| Model | Type | ELPD | ELPD_SE | LOOIC | LOOIC_SE | WAIC | R2 | R2_marginal | R2_adjusted | RMSE | Sigma |
|---|---|---|---|---|---|---|---|---|---|---|---|
| model_dimensional | stanreg | -1621 | 17 | 3242 | 34 | 3242 | 0.41 | 0.09 | 0.40 | 2.2 | 2.3 |
| model_profile | stanreg | -1641 | 17 | 3282 | 33 | 3282 | 0.38 | 0.03 | 0.37 | 2.3 | 2.3 |
parameters::parameters_table(model_parameters(model_profile))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior |
|---|---|---|---|---|---|---|---|
| (Intercept) | 4.39 | [ 2.99, 5.78] | 99.98% | 0.02% | 1.003 | 853.87 | Normal (4.02 +- 7.35) |
| LIE_ProfileTrickster | -0.37 | [-0.68, -0.07] | 97.42% | 34.88% | 1.000 | 3409.34 | Normal (0.00 +- 15.40) |
| LIE_ProfileVirtuous | 0.67 | [ 0.34, 1.05] | 99.85% | 4.42% | 0.999 | 3320.64 | Normal (0.00 +- 17.58) |
parameters::parameters_table(model_parameters(model_dimensional))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | 4.42 | [ 3.08, 5.54] | 100% | 0% | 1.008 | 810.47 | Normal (4.02 +- 7.35) |
| 2 | LIE_Ability | -0.01 | [-0.09, 0.07] | 59.00% | 100% | 0.999 | 4395.75 | Normal (0.00 +- 3.19) |
| 4 | LIE_Frequency | 0.25 | [ 0.14, 0.36] | 100% | 77.08% | 1.001 | 3469.94 | Normal (0.00 +- 3.96) |
| 3 | LIE_Contextuality | -0.25 | [-0.37, -0.12] | 99.98% | 72.08% | 1.000 | 4166.38 | Normal (0.00 +- 5.47) |
| 5 | LIE_Negativity | 0.53 | [ 0.38, 0.68] | 100% | 0.75% | 1.000 | 3290.13 | Normal (0.00 +- 5.57) |
model_profile %>%
estimate_means() %>%
mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
geom_line(aes(group = 1), size = 1) +
geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
theme_modern() +
scale_color_manual(values = colors_cluster, guide = FALSE) +
ylab("Faith") +
xlab("Deception Profile")
sig <- model_parameters(model_dimensional)[-1,] %>%
select(Parameter, pd) %>%
mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
Text = format_pd(pd, stars_only=TRUE),
Predicted = 6.5,
Score = dplyr::filter(df, !is.na(Religion_Faith)) %>%
select(one_of(Parameter)) %>%
summarise_all(function(x) {mean(range(x))}) %>%
t()) %>%
mutate(Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality"))
p_religion <- rbind(estimate_link(model_dimensional, target="LIE_Ability") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Frequency") %>%
mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Contextuality") %>%
mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
estimate_link(model_dimensional, target="LIE_Negativity") %>%
mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
mutate(Dimension = str_remove(Dimension, "LIE_"),
Dimension = fct_relevel(Dimension, "Frequency", "Ability", "Negativity", "Contextuality")) %>%
ggplot(aes(x = Score, y = Predicted)) +
geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
geom_line(aes(color=Dimension), size = 1) +
theme_modern() +
theme(strip.placement = "outside",
strip.text = element_text(size=13, face="plain"),
axis.title = element_text(size=13),
axis.text = element_text(size=9),
plot.title = element_text(face="bold", hjust = 0.5)) +
geom_text(data = sig, aes(label = Text)) +
ggtitle("Religion") +
ylab("\nFaith") +
xlab("") +
scale_color_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
scale_fill_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")# Combine plots
combine_plots <- cowplot::plot_grid(p_sex, p_age, p_income, p_religion, nrow=2)
ggsave("figures/demographics.png", combine_plots, height=figwidth, width=figwidth)Number of Lies
Raw
df$Lying_Frequency <- (df$Lying_Frequency_Day + df$Lying_Frequency_Week / 7) / 2
outliers <- check_outliers(df$Lying_Frequency, method = "zscore", threshold = list("zscore" = stats::qnorm(p = 0.999)))
df$Lying_Frequency[outliers == 1] <- NA
p_freq1 <- df %>%
filter(!is.na(Lying_Frequency)) %>%
ggplot(aes(x = Lying_Frequency)) +
geom_histogram(aes(y=..density.., fill = ..x..), binwidth = 1/7) +
geom_line(data=estimate_density(df$Lying_Frequency, method = "kernSmooth"),
aes(x = x, y = y), color = "#2196F3", size = 1.5) +
scale_fill_gradient(low='#AD1457', high='#F48FB1', guide = FALSE) +
ylab("Distribution of Participants") +
xlab(expression(paste('Lying Frequency ', italic("(lies / day)")))) +
theme_modern() +
theme(axis.text.y = element_blank())library(ggforce)
df %>%
filter(!is.na(Lying_Frequency)) %>%
dplyr::select(starts_with("LIE"), Lying_Frequency) %>%
ggplot(aes(x = .panel_x, y = .panel_y, fill = LIE_Profile, colour = LIE_Profile)) +
geom_point(alpha = 1, shape = 16, size = 0.5) +
geom_smooth(method = 'lm', formula = y ~ poly(x, 1), alpha = 0.1) +
scale_color_manual(values = colors_cluster) +
scale_fill_manual(values = colors_cluster) +
ggforce::facet_matrix(cols = vars(LIE_Ability , LIE_Frequency, LIE_Negativity, LIE_Contextuality), rows = vars(Lying_Frequency)) +
coord_cartesian(ylim = c(0, 5)) +
theme_modern()
model_profile <- stan_glm(Lying_Frequency ~ LIE_Profile, data = df, refresh = 0, seed=333)
model_dimensional <- stan_glm(Lying_Frequency ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity, data = df, refresh = 0, seed=333)
performance::compare_performance(model_dimensional, model_profile)| Model | Type | ELPD | ELPD_SE | LOOIC | LOOIC_SE | WAIC | R2 | R2_adjusted | RMSE | Sigma |
|---|---|---|---|---|---|---|---|---|---|---|
| model_dimensional | stanreg | -903 | 22 | 1807 | 44 | 1807 | 0.16 | 0.15 | 0.87 | 0.87 |
| model_profile | stanreg | -918 | 21 | 1837 | 43 | 1837 | 0.12 | 0.11 | 0.89 | 0.89 |
parameters::parameters_table(model_parameters(model_profile))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior |
|---|---|---|---|---|---|---|---|
| (Intercept) | 1.08 | [ 0.99, 1.15] | 100% | 0% | 1.000 | 4095.27 | Normal (1.16 +- 2.36) |
| LIE_ProfileTrickster | 0.51 | [ 0.39, 0.64] | 100% | 0% | 1.000 | 3650.96 | Normal (0.00 +- 5.05) |
| LIE_ProfileVirtuous | -0.35 | [-0.49, -0.22] | 100% | 0.15% | 0.999 | 4190.49 | Normal (0.00 +- 5.52) |
parameters::parameters_table(model_parameters(model_dimensional))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | 1.18 | [ 1.13, 1.23] | 100% | 0% | 1.000 | 4102.80 | Normal (1.16 +- 2.36) |
| 2 | LIE_Ability | 7.38e-03 | [-0.02, 0.04] | 65.65% | 100% | 1.001 | 3097.72 | Normal (0.00 +- 1.02) |
| 4 | LIE_Frequency | 0.17 | [ 0.13, 0.21] | 100% | 0.15% | 1.000 | 3445.35 | Normal (0.00 +- 1.31) |
| 3 | LIE_Contextuality | 0.04 | [ 0.00, 0.09] | 94.23% | 95.83% | 1.000 | 3503.00 | Normal (0.00 +- 1.76) |
| 5 | LIE_Negativity | -0.03 | [-0.09, 0.03] | 78.77% | 94.45% | 1.001 | 3273.09 | Normal (0.00 +- 1.83) |
p_freq2 <- model_dimensional %>%
estimate_link(target = "LIE_Frequency", length = 10, smooth_strength = 0) %>%
ggplot(aes(x = LIE_Frequency, y = Predicted)) +
geom_point2(data = df, aes(y = Lying_Frequency, color = Lying_Frequency), size = 4, alpha=0.7) +
geom_ribbon(aes(ymin = CI_low, ymax = CI_high), alpha = 0.2) +
geom_line(size = 1.5) +
scale_color_gradient(low='#AD1457', high='#F48FB1', guide = FALSE) +
theme_modern() +
ylab("Absolute Lying Frequency (lies / day)") +
xlab("LIE - Frequency") +
theme(plot.margin = unit(c(5.5, 0, 5.5, 5.5), "pt"))# Combine plots
cowplot::plot_grid(p_freq2,
p_freq1 +
coord_flip() +
xlab("") +
ylab("") +
theme(axis.line = element_blank(),
axis.text.x = element_blank(),
axis.title.y = element_blank(),
axis.line.y = element_blank(),
axis.ticks.y=element_blank(),
plot.margin = unit(c(0, 0, 10, -20), "pt")),
nrow=1, rel_widths = c(0.75, 0.25))
Adjusted
df$Lying_Frequency_Adjusted <- effectsize::adjust(df, select = "Lying_Frequency", effect = c("BIDR_ImpressionManagement", "BIDR_SelfDeceptiveEnhancement"))$Lying_Frequency
df$Lying_Frequency_Adjusted <- df$Lying_Frequency_Adjusted + abs(min(df$Lying_Frequency_Adjusted, na.rm=TRUE))
p_freq1adj <- df %>%
filter(!is.na(Lying_Frequency_Adjusted)) %>%
ggplot(aes(x = Lying_Frequency_Adjusted)) +
geom_histogram(aes(y=..density.., fill = ..x..), binwidth = 1/7) +
geom_line(data=estimate_density(df$Lying_Frequency_Adjusted, method = "kernSmooth"),
aes(x = x, y = y), color = "red", size = 1.5) +
scale_fill_gradient(low='#1A237E', high='#2196F3', guide = FALSE) +
ylab("Distribution of Participants") +
xlab(expression(paste('Lying Frequency ', italic("(lies / day)")))) +
theme_modern() +
theme(axis.text.y = element_blank())library(ggforce)
df %>%
filter(!is.na(Lying_Frequency_Adjusted)) %>%
dplyr::select(starts_with("LIE"), Lying_Frequency_Adjusted) %>%
ggplot(aes(x = .panel_x, y = .panel_y, fill = LIE_Profile, colour = LIE_Profile)) +
geom_point(alpha = 1, shape = 16, size = 0.5) +
geom_smooth(method = 'lm', formula = y ~ poly(x, 1), alpha = 0.1) +
scale_color_manual(values = colors_cluster) +
scale_fill_manual(values = colors_cluster) +
ggforce::facet_matrix(cols = vars(LIE_Ability , LIE_Frequency, LIE_Negativity, LIE_Contextuality), rows = vars(Lying_Frequency_Adjusted)) +
coord_cartesian(ylim = c(0, 5)) +
theme_modern()
model_profile <- stan_glm(Lying_Frequency_Adjusted ~ LIE_Profile, data = df, refresh = 0, seed=333)
model_dimensional <- stan_glm(Lying_Frequency_Adjusted ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity, data = df, refresh = 0, seed=333)
performance::compare_performance(model_dimensional, model_profile)| Model | Type | ELPD | ELPD_SE | LOOIC | LOOIC_SE | WAIC | R2 | R2_adjusted | RMSE | Sigma |
|---|---|---|---|---|---|---|---|---|---|---|
| model_dimensional | stanreg | -913 | 22 | 1825 | 44 | 1825 | 0.10 | 0.08 | 0.88 | 0.88 |
| model_profile | stanreg | -919 | 21 | 1838 | 43 | 1838 | 0.07 | 0.07 | 0.89 | 0.89 |
parameters::parameters_table(model_parameters(model_profile))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior |
|---|---|---|---|---|---|---|---|
| (Intercept) | 1.47 | [ 1.38, 1.54] | 100% | 0% | 0.999 | 4030.29 | Normal (1.54 +- 2.31) |
| LIE_ProfileTrickster | 0.41 | [ 0.28, 0.53] | 100% | 0% | 0.999 | 3964.79 | Normal (0.00 +- 4.94) |
| LIE_ProfileVirtuous | -0.24 | [-0.38, -0.11] | 99.85% | 3.15% | 1.000 | 4097.41 | Normal (0.00 +- 5.39) |
parameters::parameters_table(model_parameters(model_dimensional))| Parameter | Median | 89% CI | pd | % in ROPE | Rhat | ESS | Prior | |
|---|---|---|---|---|---|---|---|---|
| 1 | (Intercept) | 1.56 | [ 1.51, 1.61] | 100% | 0% | 1.000 | 4430.76 | Normal (1.54 +- 2.31) |
| 2 | LIE_Ability | 0.01 | [-0.02, 0.04] | 76.00% | 100% | 1.000 | 3546.49 | Normal (0.00 +- 1.00) |
| 4 | LIE_Frequency | 0.14 | [ 0.10, 0.19] | 100% | 2.70% | 1.000 | 3433.41 | Normal (0.00 +- 1.28) |
| 3 | LIE_Contextuality | 9.35e-03 | [-0.04, 0.06] | 62.45% | 99.65% | 1.000 | 3491.33 | Normal (0.00 +- 1.72) |
| 5 | LIE_Negativity | -7.34e-03 | [-0.07, 0.06] | 56.95% | 97.55% | 1.000 | 3332.26 | Normal (0.00 +- 1.79) |
p_freq2adj <- model_dimensional %>%
estimate_link(target = "LIE_Frequency", length = 10, smooth_strength = 0) %>%
ggplot(aes(x = LIE_Frequency, y = Predicted)) +
geom_point2(data = df, aes(y = Lying_Frequency_Adjusted, color = Lying_Frequency_Adjusted), size = 4, alpha=0.7) +
geom_ribbon(aes(ymin = CI_low, ymax = CI_high), alpha = 0.2) +
geom_line(size = 1.5) +
scale_color_gradient(low='#1A237E', high='#2196F3', guide = FALSE) +
theme_modern() +
ylab("Absolute Lying Frequency (lies / day)") +
xlab("LIE - Frequency") +
theme(plot.margin = unit(c(5.5, 0, 5.5, 5.5), "pt"))# Combine plots
p <- cowplot::plot_grid(p_freq2adj,
p_freq1adj +
coord_flip() +
xlab("") +
ylab("") +
theme(axis.line = element_blank(),
axis.text.x = element_blank(),
axis.title.y = element_blank(),
axis.line.y = element_blank(),
axis.ticks.y=element_blank(),
plot.margin = unit(c(0, 0, 10, -20), "pt")),
nrow=1, rel_widths = c(0.75, 0.25))
ggsave("figures/figure_absolutelying_adjusted.png", p, height=figheight, width=figwidth)Social Desirability (BIDR)
Utility Functions
library(ggraph)
library(tidygraph)
colors_nodes <- c("LIE"= "#9C27B0",
"Psychopathy" = "#f44336",
"Narcissism" = "#FF9800",
"Pathological Personality" = "#FFC107",
"Normal Personality" = "#4CAF50",
"Social Desirability" = "#795548",
"Light Triad" = "#2196F3",
"Impulsivity" = "#673AB7",
"Emotion Regulation" = "#E91E63",
"Interoception" = "#b71c1c")
# convenience function
create_ggm <- function(data, title = "Pychopathy (TRIMP)", title_size=22, label_edges = TRUE, node_size=32, text_size=5.5, layout="kk", seed=333, bend=0.2){
set.seed(seed)
label_edges <- ifelse(rep_len(label_edges, length.out=nrow(data$edges)), insight::format_value(data$edges$r), "")
data %>%
ggraph(layout = layout) +
geom_edge_arc(aes(colour=r, edge_width = abs(r), label = label_edges),
strength=bend,
angle_calc = 'along',
label_dodge = unit(3.5, 'mm'),
check_overlap = FALSE) +
geom_node_point(aes(colour = Questionnaire), size=node_size) +
geom_node_text(aes(label = name), colour="white", check_overlap = FALSE, repel = FALSE, size=text_size, fontface="bold") +
scale_edge_color_gradient2(low = "#d50000", high = "#00C853") +
scale_color_manual(values = colors_nodes) +
theme_graph() +
guides(edge_width = FALSE,
edge_color = FALSE,
colour = FALSE) +
scale_x_continuous(expand = expand_scale(c(.15, .15))) +
scale_y_continuous(expand = expand_scale(c(.15, .15))) +
theme(plot.title = element_text(hjust = 0.5, face="bold", size = title_size),
plot.margin = unit(c(0, 0, 0, 0), "cm")) +
ggtitle(title)
}Gaussian Graphical Model
cor_bidr <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("BIDR"), -BIDR_General),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_bidr)| Parameter1 | Parameter2 | r | 95% CI | t(760) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.27 | [ 0.20, 0.34] | 7.78 | < .001 | Pearson | 762 |
| LIE_Frequency | LIE_Negativity | -0.55 | [-0.60, -0.50] | -18.09 | < .001 | Pearson | 762 |
| LIE_Frequency | LIE_Contextuality | -0.17 | [-0.23, -0.10] | -4.63 | < .001 | Pearson | 762 |
| LIE_Frequency | BIDR_SelfDeceptiveEnhancement | -0.20 | [-0.27, -0.13] | -5.62 | < .001 | Pearson | 762 |
| LIE_Frequency | BIDR_ImpressionManagement | -0.13 | [-0.20, -0.06] | -3.51 | < .001 | Pearson | 762 |
| LIE_Ability | LIE_Negativity | -0.17 | [-0.23, -0.10] | -4.64 | < .001 | Pearson | 762 |
| LIE_Ability | LIE_Contextuality | 0.34 | [ 0.27, 0.40] | 9.92 | < .001 | Pearson | 762 |
| LIE_Ability | BIDR_SelfDeceptiveEnhancement | 0.21 | [ 0.14, 0.28] | 5.98 | < .001 | Pearson | 762 |
| LIE_Ability | BIDR_ImpressionManagement | -0.08 | [-0.15, -0.01] | -2.21 | 0.027 | Pearson | 762 |
| LIE_Negativity | LIE_Contextuality | -0.26 | [-0.33, -0.20] | -7.54 | < .001 | Pearson | 762 |
| LIE_Negativity | BIDR_SelfDeceptiveEnhancement | -0.07 | [-0.14, 0.00] | -1.90 | 0.057 | Pearson | 762 |
| LIE_Negativity | BIDR_ImpressionManagement | 0.12 | [ 0.05, 0.19] | 3.35 | < .001 | Pearson | 762 |
| LIE_Contextuality | BIDR_SelfDeceptiveEnhancement | -0.11 | [-0.18, -0.04] | -2.95 | 0.003 | Pearson | 762 |
| LIE_Contextuality | BIDR_ImpressionManagement | -0.17 | [-0.24, -0.10] | -4.80 | < .001 | Pearson | 762 |
| BIDR_SelfDeceptiveEnhancement | BIDR_ImpressionManagement | 0.26 | [ 0.20, 0.33] | 7.50 | < .001 | Pearson | 762 |
graphdata_bidr <- cor_bidr %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_bidr$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_bidr$nodes$name, "LIE_"),
"LIE", "Social Desirability")
graphdata_bidr$nodes$name <- stringr::str_remove(graphdata_bidr$nodes$name, "LIE_|BIDR_")
graphdata_bidr$nodes$name <- stringr::str_replace(graphdata_bidr$nodes$name, "fD", "f-D")
graphdata_bidr$nodes$name <- stringr::str_replace(graphdata_bidr$nodes$name, "nM", "n\nM")
graphdata_bidr$nodes$name <- stringr::str_replace(graphdata_bidr$nodes$name, "eE", "e\nE")
ggm_bidr <- create_ggm(graphdata_bidr, title = "Social Desirability", layout="sugiyama")
ggm_bidr
After controlling for social desirability, it seems that the relationship between frequency and contextuality changed from being positive to negative. The more people lie (likely representing a lack of control), and the less flexible and insensitive to the context they are.
Psychopathy (TRIMP)
cor_trimp <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), -LIE_Profile, TRIMP_Boldness, TRIMP_Meanness, TRIMP_Disinhibition),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_trimp)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.26 | [ 0.19, 0.33] | 7.44 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.53 | [-0.58, -0.48] | -17.25 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.15 | [-0.22, -0.08] | -4.17 | < .001 | Pearson | 757 |
| LIE_Frequency | TRIMP_Boldness | 4.17e-04 | [-0.07, 0.07] | 0.01 | 0.991 | Pearson | 757 |
| LIE_Frequency | TRIMP_Meanness | -0.03 | [-0.10, 0.05] | -0.71 | 0.476 | Pearson | 757 |
| LIE_Frequency | TRIMP_Disinhibition | 0.23 | [ 0.17, 0.30] | 6.62 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.15 | [-0.22, -0.08] | -4.06 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.34 | [ 0.28, 0.41] | 10.09 | < .001 | Pearson | 757 |
| LIE_Ability | TRIMP_Boldness | 0.23 | [ 0.16, 0.30] | 6.50 | < .001 | Pearson | 757 |
| LIE_Ability | TRIMP_Meanness | -0.02 | [-0.09, 0.05] | -0.53 | 0.596 | Pearson | 757 |
| LIE_Ability | TRIMP_Disinhibition | 0.04 | [-0.04, 0.11] | 0.99 | 0.325 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.26 | [-0.33, -0.20] | -7.53 | < .001 | Pearson | 757 |
| LIE_Negativity | TRIMP_Boldness | 0.03 | [-0.04, 0.10] | 0.74 | 0.461 | Pearson | 757 |
| LIE_Negativity | TRIMP_Meanness | -0.19 | [-0.26, -0.12] | -5.31 | < .001 | Pearson | 757 |
| LIE_Negativity | TRIMP_Disinhibition | 0.15 | [ 0.08, 0.22] | 4.09 | < .001 | Pearson | 757 |
| LIE_Contextuality | TRIMP_Boldness | -0.08 | [-0.15, -0.01] | -2.25 | 0.024 | Pearson | 757 |
| LIE_Contextuality | TRIMP_Meanness | -0.03 | [-0.10, 0.04] | -0.79 | 0.431 | Pearson | 757 |
| LIE_Contextuality | TRIMP_Disinhibition | -0.01 | [-0.08, 0.06] | -0.36 | 0.719 | Pearson | 757 |
| TRIMP_Boldness | TRIMP_Meanness | 0.29 | [ 0.22, 0.35] | 8.18 | < .001 | Pearson | 757 |
| TRIMP_Boldness | TRIMP_Disinhibition | -0.30 | [-0.36, -0.23] | -8.60 | < .001 | Pearson | 757 |
| TRIMP_Meanness | TRIMP_Disinhibition | 0.62 | [ 0.58, 0.66] | 21.84 | < .001 | Pearson | 757 |
graphdata_trimp <- cor_trimp %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_trimp$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_trimp$nodes$name, "LIE_"),
"LIE", "Psychopathy")
graphdata_trimp$nodes$name <- stringr::str_remove(graphdata_trimp$nodes$name, "LIE_|TRIMP_")
create_ggm(graphdata_trimp, title = "Pychopathy")
Narcissism (FFNI)
cor_ffni <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("FFNI"), -FFNI_General),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_ffni)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.24 | [ 0.17, 0.31] | 6.80 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.54 | [-0.59, -0.49] | -17.68 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.17 | [-0.24, -0.10] | -4.72 | < .001 | Pearson | 757 |
| LIE_Frequency | FFNI_AcclaimSeeking | 0.02 | [-0.05, 0.09] | 0.46 | 0.649 | Pearson | 757 |
| LIE_Frequency | FFNI_Distrust | -0.03 | [-0.10, 0.04] | -0.78 | 0.436 | Pearson | 757 |
| LIE_Frequency | FFNI_Entitlement | 0.08 | [ 0.01, 0.15] | 2.33 | 0.020 | Pearson | 757 |
| LIE_Frequency | FFNI_Exploitativeness | -0.01 | [-0.08, 0.06] | -0.30 | 0.761 | Pearson | 757 |
| LIE_Frequency | FFNI_Indifference | 0.06 | [-0.01, 0.13] | 1.67 | 0.096 | Pearson | 757 |
| LIE_Frequency | FFNI_LackOfEmpathy | 0.10 | [ 0.03, 0.17] | 2.84 | 0.005 | Pearson | 757 |
| LIE_Frequency | FFNI_Manipulativeness | -9.12e-03 | [-0.08, 0.06] | -0.25 | 0.802 | Pearson | 757 |
| LIE_Frequency | FFNI_NeedForAdmiration | 0.10 | [ 0.03, 0.17] | 2.69 | 0.007 | Pearson | 757 |
| LIE_Frequency | FFNI_ThrillSeeking | 0.04 | [-0.03, 0.11] | 1.01 | 0.312 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.17 | [-0.24, -0.10] | -4.81 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.33 | [ 0.27, 0.39] | 9.66 | < .001 | Pearson | 757 |
| LIE_Ability | FFNI_AcclaimSeeking | -0.03 | [-0.10, 0.04] | -0.74 | 0.459 | Pearson | 757 |
| LIE_Ability | FFNI_Distrust | 0.06 | [-0.01, 0.13] | 1.62 | 0.105 | Pearson | 757 |
| LIE_Ability | FFNI_Entitlement | -0.02 | [-0.09, 0.05] | -0.63 | 0.527 | Pearson | 757 |
| LIE_Ability | FFNI_Exploitativeness | -0.12 | [-0.19, -0.05] | -3.22 | 0.001 | Pearson | 757 |
| LIE_Ability | FFNI_Indifference | -0.01 | [-0.09, 0.06] | -0.39 | 0.696 | Pearson | 757 |
| LIE_Ability | FFNI_LackOfEmpathy | -0.05 | [-0.12, 0.02] | -1.29 | 0.198 | Pearson | 757 |
| LIE_Ability | FFNI_Manipulativeness | 0.35 | [ 0.29, 0.42] | 10.42 | < .001 | Pearson | 757 |
| LIE_Ability | FFNI_NeedForAdmiration | 1.70e-03 | [-0.07, 0.07] | 0.05 | 0.963 | Pearson | 757 |
| LIE_Ability | FFNI_ThrillSeeking | 0.03 | [-0.04, 0.10] | 0.77 | 0.442 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.26 | [-0.33, -0.20] | -7.53 | < .001 | Pearson | 757 |
| LIE_Negativity | FFNI_AcclaimSeeking | 0.10 | [ 0.03, 0.17] | 2.81 | 0.005 | Pearson | 757 |
| LIE_Negativity | FFNI_Distrust | -8.72e-03 | [-0.08, 0.06] | -0.24 | 0.811 | Pearson | 757 |
| LIE_Negativity | FFNI_Entitlement | 0.09 | [ 0.02, 0.16] | 2.52 | 0.012 | Pearson | 757 |
| LIE_Negativity | FFNI_Exploitativeness | -0.13 | [-0.20, -0.05] | -3.48 | < .001 | Pearson | 757 |
| LIE_Negativity | FFNI_Indifference | 0.04 | [-0.03, 0.11] | 1.12 | 0.261 | Pearson | 757 |
| LIE_Negativity | FFNI_LackOfEmpathy | -2.62e-03 | [-0.07, 0.07] | -0.07 | 0.943 | Pearson | 757 |
| LIE_Negativity | FFNI_Manipulativeness | 0.06 | [-0.01, 0.13] | 1.73 | 0.083 | Pearson | 757 |
| LIE_Negativity | FFNI_NeedForAdmiration | 0.10 | [ 0.03, 0.17] | 2.88 | 0.004 | Pearson | 757 |
| LIE_Negativity | FFNI_ThrillSeeking | -0.02 | [-0.09, 0.05] | -0.49 | 0.627 | Pearson | 757 |
| LIE_Contextuality | FFNI_AcclaimSeeking | 0.11 | [ 0.04, 0.18] | 2.98 | 0.003 | Pearson | 757 |
| LIE_Contextuality | FFNI_Distrust | 0.02 | [-0.05, 0.09] | 0.55 | 0.581 | Pearson | 757 |
| LIE_Contextuality | FFNI_Entitlement | -0.04 | [-0.11, 0.04] | -0.97 | 0.330 | Pearson | 757 |
| LIE_Contextuality | FFNI_Exploitativeness | 0.04 | [-0.04, 0.11] | 0.98 | 0.327 | Pearson | 757 |
| LIE_Contextuality | FFNI_Indifference | 0.04 | [-0.03, 0.12] | 1.22 | 0.224 | Pearson | 757 |
| LIE_Contextuality | FFNI_LackOfEmpathy | 9.99e-03 | [-0.06, 0.08] | 0.27 | 0.784 | Pearson | 757 |
| LIE_Contextuality | FFNI_Manipulativeness | -0.11 | [-0.18, -0.03] | -2.91 | 0.004 | Pearson | 757 |
| LIE_Contextuality | FFNI_NeedForAdmiration | 0.09 | [ 0.02, 0.16] | 2.47 | 0.014 | Pearson | 757 |
| LIE_Contextuality | FFNI_ThrillSeeking | 0.03 | [-0.05, 0.10] | 0.72 | 0.473 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_Distrust | 0.05 | [-0.02, 0.12] | 1.36 | 0.173 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_Entitlement | 0.12 | [ 0.05, 0.19] | 3.38 | < .001 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_Exploitativeness | 5.27e-03 | [-0.07, 0.08] | 0.14 | 0.885 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_Indifference | 0.05 | [-0.02, 0.12] | 1.49 | 0.137 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_LackOfEmpathy | -0.15 | [-0.22, -0.08] | -4.30 | < .001 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_Manipulativeness | 0.20 | [ 0.13, 0.27] | 5.73 | < .001 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_NeedForAdmiration | -0.06 | [-0.13, 0.01] | -1.62 | 0.106 | Pearson | 757 |
| FFNI_AcclaimSeeking | FFNI_ThrillSeeking | 0.17 | [ 0.10, 0.24] | 4.87 | < .001 | Pearson | 757 |
| FFNI_Distrust | FFNI_Entitlement | 0.08 | [ 0.00, 0.15] | 2.08 | 0.038 | Pearson | 757 |
| FFNI_Distrust | FFNI_Exploitativeness | 0.18 | [ 0.11, 0.25] | 4.95 | < .001 | Pearson | 757 |
| FFNI_Distrust | FFNI_Indifference | 0.11 | [ 0.04, 0.18] | 3.12 | 0.002 | Pearson | 757 |
| FFNI_Distrust | FFNI_LackOfEmpathy | 0.06 | [-0.01, 0.14] | 1.78 | 0.076 | Pearson | 757 |
| FFNI_Distrust | FFNI_Manipulativeness | -0.06 | [-0.13, 0.02] | -1.52 | 0.129 | Pearson | 757 |
| FFNI_Distrust | FFNI_NeedForAdmiration | 0.17 | [ 0.10, 0.24] | 4.83 | < .001 | Pearson | 757 |
| FFNI_Distrust | FFNI_ThrillSeeking | -0.04 | [-0.11, 0.03] | -1.06 | 0.288 | Pearson | 757 |
| FFNI_Entitlement | FFNI_Exploitativeness | 0.28 | [ 0.21, 0.34] | 8.01 | < .001 | Pearson | 757 |
| FFNI_Entitlement | FFNI_Indifference | -0.03 | [-0.10, 0.04] | -0.73 | 0.467 | Pearson | 757 |
| FFNI_Entitlement | FFNI_LackOfEmpathy | 0.24 | [ 0.17, 0.31] | 6.82 | < .001 | Pearson | 757 |
| FFNI_Entitlement | FFNI_Manipulativeness | 0.07 | [ 0.00, 0.14] | 1.95 | 0.052 | Pearson | 757 |
| FFNI_Entitlement | FFNI_NeedForAdmiration | 0.12 | [ 0.05, 0.19] | 3.24 | 0.001 | Pearson | 757 |
| FFNI_Entitlement | FFNI_ThrillSeeking | 0.07 | [ 0.00, 0.14] | 2.02 | 0.043 | Pearson | 757 |
| FFNI_Exploitativeness | FFNI_Indifference | -0.06 | [-0.13, 0.02] | -1.52 | 0.129 | Pearson | 757 |
| FFNI_Exploitativeness | FFNI_LackOfEmpathy | 0.24 | [ 0.17, 0.31] | 6.88 | < .001 | Pearson | 757 |
| FFNI_Exploitativeness | FFNI_Manipulativeness | 0.41 | [ 0.35, 0.47] | 12.39 | < .001 | Pearson | 757 |
| FFNI_Exploitativeness | FFNI_NeedForAdmiration | 0.07 | [ 0.00, 0.14] | 2.04 | 0.042 | Pearson | 757 |
| FFNI_Exploitativeness | FFNI_ThrillSeeking | 0.06 | [-0.02, 0.13] | 1.52 | 0.130 | Pearson | 757 |
| FFNI_Indifference | FFNI_LackOfEmpathy | 0.33 | [ 0.27, 0.39] | 9.67 | < .001 | Pearson | 757 |
| FFNI_Indifference | FFNI_Manipulativeness | 0.14 | [ 0.07, 0.21] | 3.87 | < .001 | Pearson | 757 |
| FFNI_Indifference | FFNI_NeedForAdmiration | -0.46 | [-0.51, -0.40] | -14.19 | < .001 | Pearson | 757 |
| FFNI_Indifference | FFNI_ThrillSeeking | 0.15 | [ 0.08, 0.22] | 4.21 | < .001 | Pearson | 757 |
| FFNI_LackOfEmpathy | FFNI_Manipulativeness | -0.04 | [-0.11, 0.03] | -1.07 | 0.287 | Pearson | 757 |
| FFNI_LackOfEmpathy | FFNI_NeedForAdmiration | 0.02 | [-0.05, 0.09] | 0.52 | 0.606 | Pearson | 757 |
| FFNI_LackOfEmpathy | FFNI_ThrillSeeking | 0.09 | [ 0.01, 0.16] | 2.36 | 0.018 | Pearson | 757 |
| FFNI_Manipulativeness | FFNI_NeedForAdmiration | 5.52e-03 | [-0.07, 0.08] | 0.15 | 0.879 | Pearson | 757 |
| FFNI_Manipulativeness | FFNI_ThrillSeeking | 0.13 | [ 0.06, 0.20] | 3.60 | < .001 | Pearson | 757 |
| FFNI_NeedForAdmiration | FFNI_ThrillSeeking | 0.05 | [-0.02, 0.12] | 1.39 | 0.165 | Pearson | 757 |
graphdata_ffni <- cor_ffni %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_ffni$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_ffni$nodes$name, "LIE_"),
"LIE", "Narcissism")
graphdata_ffni$nodes$name <- stringr::str_remove(graphdata_ffni$nodes$name, "LIE_|FFNI_")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "dForA", "d for\nA")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "mS", "m\nS")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "lS", "l\nS")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "kOfE", "k of\nE")
ggm_ffni <- create_ggm(graphdata_ffni, title = "Narcissism", node_size=38)
ggm_ffni
Normal Personality (IPIP6)
cor_ipip <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("IPIP6")),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_ipip)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.27 | [ 0.20, 0.33] | 7.58 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.52 | [-0.57, -0.47] | -16.80 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.15 | [-0.22, -0.08] | -4.15 | < .001 | Pearson | 757 |
| LIE_Frequency | IPIP6_Extraversion | 0.04 | [-0.03, 0.11] | 1.04 | 0.300 | Pearson | 757 |
| LIE_Frequency | IPIP6_Agreableness | -0.10 | [-0.17, -0.03] | -2.90 | 0.004 | Pearson | 757 |
| LIE_Frequency | IPIP6_Conscientiousness | -0.11 | [-0.18, -0.04] | -2.93 | 0.003 | Pearson | 757 |
| LIE_Frequency | IPIP6_Neuroticism | 0.06 | [-0.01, 0.13] | 1.77 | 0.077 | Pearson | 757 |
| LIE_Frequency | IPIP6_Openness | -0.08 | [-0.15, 0.00] | -2.10 | 0.036 | Pearson | 757 |
| LIE_Frequency | IPIP6_HonestyHumility | -0.09 | [-0.16, -0.02] | -2.59 | 0.010 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.15 | [-0.22, -0.08] | -4.30 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.33 | [ 0.27, 0.39] | 9.67 | < .001 | Pearson | 757 |
| LIE_Ability | IPIP6_Extraversion | 0.09 | [ 0.02, 0.16] | 2.39 | 0.017 | Pearson | 757 |
| LIE_Ability | IPIP6_Agreableness | 0.01 | [-0.06, 0.09] | 0.40 | 0.686 | Pearson | 757 |
| LIE_Ability | IPIP6_Conscientiousness | 0.02 | [-0.05, 0.09] | 0.47 | 0.642 | Pearson | 757 |
| LIE_Ability | IPIP6_Neuroticism | -0.04 | [-0.11, 0.03] | -1.11 | 0.268 | Pearson | 757 |
| LIE_Ability | IPIP6_Openness | 0.15 | [ 0.08, 0.22] | 4.19 | < .001 | Pearson | 757 |
| LIE_Ability | IPIP6_HonestyHumility | -0.11 | [-0.18, -0.04] | -2.94 | 0.003 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.27 | [-0.34, -0.21] | -7.81 | < .001 | Pearson | 757 |
| LIE_Negativity | IPIP6_Extraversion | -0.08 | [-0.15, -0.01] | -2.25 | 0.024 | Pearson | 757 |
| LIE_Negativity | IPIP6_Agreableness | 0.11 | [ 0.04, 0.18] | 2.98 | 0.003 | Pearson | 757 |
| LIE_Negativity | IPIP6_Conscientiousness | 0.08 | [ 0.01, 0.15] | 2.11 | 0.035 | Pearson | 757 |
| LIE_Negativity | IPIP6_Neuroticism | 0.02 | [-0.05, 0.09] | 0.50 | 0.616 | Pearson | 757 |
| LIE_Negativity | IPIP6_Openness | -0.04 | [-0.11, 0.03] | -1.01 | 0.315 | Pearson | 757 |
| LIE_Negativity | IPIP6_HonestyHumility | -0.15 | [-0.22, -0.08] | -4.09 | < .001 | Pearson | 757 |
| LIE_Contextuality | IPIP6_Extraversion | -0.11 | [-0.18, -0.03] | -2.93 | 0.004 | Pearson | 757 |
| LIE_Contextuality | IPIP6_Agreableness | 7.88e-03 | [-0.06, 0.08] | 0.22 | 0.829 | Pearson | 757 |
| LIE_Contextuality | IPIP6_Conscientiousness | 0.08 | [ 0.01, 0.15] | 2.31 | 0.021 | Pearson | 757 |
| LIE_Contextuality | IPIP6_Neuroticism | 6.37e-03 | [-0.06, 0.08] | 0.17 | 0.861 | Pearson | 757 |
| LIE_Contextuality | IPIP6_Openness | 9.42e-03 | [-0.06, 0.08] | 0.26 | 0.796 | Pearson | 757 |
| LIE_Contextuality | IPIP6_HonestyHumility | -0.05 | [-0.12, 0.02] | -1.39 | 0.166 | Pearson | 757 |
| IPIP6_Extraversion | IPIP6_Agreableness | 0.29 | [ 0.22, 0.35] | 8.29 | < .001 | Pearson | 757 |
| IPIP6_Extraversion | IPIP6_Conscientiousness | -0.08 | [-0.15, -0.01] | -2.14 | 0.032 | Pearson | 757 |
| IPIP6_Extraversion | IPIP6_Neuroticism | -0.16 | [-0.23, -0.09] | -4.47 | < .001 | Pearson | 757 |
| IPIP6_Extraversion | IPIP6_Openness | 0.11 | [ 0.04, 0.18] | 3.11 | 0.002 | Pearson | 757 |
| IPIP6_Extraversion | IPIP6_HonestyHumility | -0.32 | [-0.38, -0.26] | -9.30 | < .001 | Pearson | 757 |
| IPIP6_Agreableness | IPIP6_Conscientiousness | 0.07 | [ 0.00, 0.15] | 2.06 | 0.040 | Pearson | 757 |
| IPIP6_Agreableness | IPIP6_Neuroticism | 0.11 | [ 0.04, 0.18] | 3.15 | 0.002 | Pearson | 757 |
| IPIP6_Agreableness | IPIP6_Openness | 0.23 | [ 0.16, 0.29] | 6.37 | < .001 | Pearson | 757 |
| IPIP6_Agreableness | IPIP6_HonestyHumility | 0.18 | [ 0.11, 0.25] | 5.12 | < .001 | Pearson | 757 |
| IPIP6_Conscientiousness | IPIP6_Neuroticism | -0.16 | [-0.22, -0.08] | -4.32 | < .001 | Pearson | 757 |
| IPIP6_Conscientiousness | IPIP6_Openness | -0.08 | [-0.15, -0.01] | -2.20 | 0.028 | Pearson | 757 |
| IPIP6_Conscientiousness | IPIP6_HonestyHumility | 0.02 | [-0.05, 0.09] | 0.50 | 0.615 | Pearson | 757 |
| IPIP6_Neuroticism | IPIP6_Openness | -2.29e-03 | [-0.07, 0.07] | -0.06 | 0.950 | Pearson | 757 |
| IPIP6_Neuroticism | IPIP6_HonestyHumility | -0.20 | [-0.27, -0.13] | -5.60 | < .001 | Pearson | 757 |
| IPIP6_Openness | IPIP6_HonestyHumility | 0.10 | [ 0.03, 0.17] | 2.81 | 0.005 | Pearson | 757 |
graphdata_ipip <- cor_ipip %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_ipip$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_ipip$nodes$name, "LIE_"),
"LIE", "Normal Personality")
graphdata_ipip$nodes$name <- stringr::str_remove(graphdata_ipip$nodes$name, "LIE_|IPIP6_")
graphdata_ipip$nodes$name <- stringr::str_replace(graphdata_ipip$nodes$name, "yH", "y /\nH")
ggm_ipip <- create_ggm(graphdata_ipip, title = "Normal Personality", layout="graphopt", node_size=40)
ggm_ipip
Pathological Personality (PID5)
cor_pid <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("PID5"), -PID5_Pathology),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_pid)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.27 | [ 0.20, 0.33] | 7.59 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.53 | [-0.58, -0.48] | -17.26 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.16 | [-0.23, -0.09] | -4.40 | < .001 | Pearson | 757 |
| LIE_Frequency | PID5_NegativeAffect | 0.04 | [-0.03, 0.11] | 1.08 | 0.279 | Pearson | 757 |
| LIE_Frequency | PID5_Detachment | 0.07 | [ 0.00, 0.14] | 1.95 | 0.051 | Pearson | 757 |
| LIE_Frequency | PID5_Antagonism | 0.04 | [-0.03, 0.11] | 1.12 | 0.263 | Pearson | 757 |
| LIE_Frequency | PID5_Disinhibition | 0.13 | [ 0.05, 0.20] | 3.48 | < .001 | Pearson | 757 |
| LIE_Frequency | PID5_Psychoticism | 3.80e-03 | [-0.07, 0.08] | 0.10 | 0.917 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.15 | [-0.22, -0.08] | -4.07 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.34 | [ 0.28, 0.40] | 10.04 | < .001 | Pearson | 757 |
| LIE_Ability | PID5_NegativeAffect | -0.05 | [-0.12, 0.02] | -1.40 | 0.161 | Pearson | 757 |
| LIE_Ability | PID5_Detachment | -0.05 | [-0.12, 0.03] | -1.26 | 0.209 | Pearson | 757 |
| LIE_Ability | PID5_Antagonism | 0.19 | [ 0.12, 0.26] | 5.42 | < .001 | Pearson | 757 |
| LIE_Ability | PID5_Disinhibition | -0.07 | [-0.14, 0.00] | -1.88 | 0.061 | Pearson | 757 |
| LIE_Ability | PID5_Psychoticism | -5.97e-03 | [-0.08, 0.07] | -0.16 | 0.870 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.27 | [-0.34, -0.21] | -7.78 | < .001 | Pearson | 757 |
| LIE_Negativity | PID5_NegativeAffect | 0.11 | [ 0.04, 0.18] | 2.95 | 0.003 | Pearson | 757 |
| LIE_Negativity | PID5_Detachment | -9.15e-03 | [-0.08, 0.06] | -0.25 | 0.801 | Pearson | 757 |
| LIE_Negativity | PID5_Antagonism | -0.02 | [-0.09, 0.05] | -0.47 | 0.642 | Pearson | 757 |
| LIE_Negativity | PID5_Disinhibition | -0.04 | [-0.11, 0.03] | -1.17 | 0.241 | Pearson | 757 |
| LIE_Negativity | PID5_Psychoticism | 0.02 | [-0.06, 0.09] | 0.44 | 0.662 | Pearson | 757 |
| LIE_Contextuality | PID5_NegativeAffect | 0.08 | [ 0.01, 0.15] | 2.29 | 0.022 | Pearson | 757 |
| LIE_Contextuality | PID5_Detachment | 0.03 | [-0.04, 0.10] | 0.80 | 0.425 | Pearson | 757 |
| LIE_Contextuality | PID5_Antagonism | -0.09 | [-0.16, -0.02] | -2.51 | 0.012 | Pearson | 757 |
| LIE_Contextuality | PID5_Disinhibition | -0.06 | [-0.13, 0.01] | -1.66 | 0.098 | Pearson | 757 |
| LIE_Contextuality | PID5_Psychoticism | 0.06 | [-0.01, 0.13] | 1.67 | 0.095 | Pearson | 757 |
| PID5_NegativeAffect | PID5_Detachment | 0.17 | [ 0.10, 0.24] | 4.81 | < .001 | Pearson | 757 |
| PID5_NegativeAffect | PID5_Antagonism | 0.14 | [ 0.07, 0.21] | 3.87 | < .001 | Pearson | 757 |
| PID5_NegativeAffect | PID5_Disinhibition | 0.16 | [ 0.09, 0.22] | 4.34 | < .001 | Pearson | 757 |
| PID5_NegativeAffect | PID5_Psychoticism | 0.25 | [ 0.18, 0.31] | 6.96 | < .001 | Pearson | 757 |
| PID5_Detachment | PID5_Antagonism | 0.13 | [ 0.06, 0.20] | 3.69 | < .001 | Pearson | 757 |
| PID5_Detachment | PID5_Disinhibition | 0.07 | [ 0.00, 0.14] | 1.94 | 0.053 | Pearson | 757 |
| PID5_Detachment | PID5_Psychoticism | 0.26 | [ 0.19, 0.33] | 7.42 | < .001 | Pearson | 757 |
| PID5_Antagonism | PID5_Disinhibition | 0.22 | [ 0.15, 0.29] | 6.26 | < .001 | Pearson | 757 |
| PID5_Antagonism | PID5_Psychoticism | 0.13 | [ 0.05, 0.20] | 3.48 | < .001 | Pearson | 757 |
| PID5_Disinhibition | PID5_Psychoticism | 0.36 | [ 0.29, 0.42] | 10.44 | < .001 | Pearson | 757 |
graphdata_pid <- cor_pid %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_pid$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_pid$nodes$name, "LIE_"),
"LIE", "Pathological Personality")
graphdata_pid$nodes$name <- stringr::str_remove(graphdata_pid$nodes$name, "LIE_|PID5_")
graphdata_pid$nodes$name <- stringr::str_replace(graphdata_pid$nodes$name, "eA", "e\nA")
ggm_pid <- create_ggm(graphdata_pid, title = "Pathological Personality", layout="graphopt", node_size=40)
ggm_pid
Light Triad (LTS)
cor_lts <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("LTS"), -LTS_General),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_lts)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.27 | [ 0.21, 0.34] | 7.84 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.52 | [-0.57, -0.47] | -16.92 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.16 | [-0.22, -0.09] | -4.32 | < .001 | Pearson | 757 |
| LIE_Frequency | LTS_FaithInHumanity | -0.11 | [-0.18, -0.04] | -3.00 | 0.003 | Pearson | 757 |
| LIE_Frequency | LTS_Humanism | 0.03 | [-0.04, 0.10] | 0.88 | 0.381 | Pearson | 757 |
| LIE_Frequency | LTS_Kantianism | 0.09 | [ 0.02, 0.16] | 2.55 | 0.011 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.16 | [-0.23, -0.09] | -4.39 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.33 | [ 0.26, 0.39] | 9.47 | < .001 | Pearson | 757 |
| LIE_Ability | LTS_FaithInHumanity | 5.60e-03 | [-0.07, 0.08] | 0.15 | 0.878 | Pearson | 757 |
| LIE_Ability | LTS_Humanism | -0.04 | [-0.11, 0.03] | -1.03 | 0.302 | Pearson | 757 |
| LIE_Ability | LTS_Kantianism | 9.49e-03 | [-0.06, 0.08] | 0.26 | 0.794 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.28 | [-0.35, -0.22] | -8.10 | < .001 | Pearson | 757 |
| LIE_Negativity | LTS_FaithInHumanity | -0.06 | [-0.13, 0.01] | -1.70 | 0.090 | Pearson | 757 |
| LIE_Negativity | LTS_Humanism | -0.06 | [-0.13, 0.01] | -1.77 | 0.078 | Pearson | 757 |
| LIE_Negativity | LTS_Kantianism | -0.12 | [-0.19, -0.04] | -3.19 | 0.001 | Pearson | 757 |
| LIE_Contextuality | LTS_FaithInHumanity | 4.30e-03 | [-0.07, 0.08] | 0.12 | 0.906 | Pearson | 757 |
| LIE_Contextuality | LTS_Humanism | -0.10 | [-0.17, -0.03] | -2.72 | 0.007 | Pearson | 757 |
| LIE_Contextuality | LTS_Kantianism | -0.04 | [-0.11, 0.03] | -1.08 | 0.281 | Pearson | 757 |
| LTS_FaithInHumanity | LTS_Humanism | 0.47 | [ 0.42, 0.53] | 14.76 | < .001 | Pearson | 757 |
| LTS_FaithInHumanity | LTS_Kantianism | 0.16 | [ 0.09, 0.23] | 4.49 | < .001 | Pearson | 757 |
| LTS_Humanism | LTS_Kantianism | 0.28 | [ 0.21, 0.34] | 7.90 | < .001 | Pearson | 757 |
graphdata_lts <- cor_lts %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_lts$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_lts$nodes$name, "LIE_"),
"LIE", "Light Triad")
graphdata_lts$nodes$name <- stringr::str_remove(graphdata_lts$nodes$name, "LIE_|LTS_")
graphdata_lts$nodes$name <- stringr::str_replace(graphdata_lts$nodes$name, "InH", " in\nH")
ggm_lts <- create_ggm(graphdata_lts, title = "Light Triad", layout="fr", bend=0.15)
ggm_lts
Impulsivity (UPPS)
cor_upps <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("UPPS"), -UPPS_General),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_upps)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.28 | [ 0.21, 0.34] | 7.90 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.52 | [-0.57, -0.47] | -16.81 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.14 | [-0.21, -0.07] | -3.93 | < .001 | Pearson | 757 |
| LIE_Frequency | UPPS_NegativeUrgency | 0.06 | [-0.01, 0.13] | 1.76 | 0.079 | Pearson | 757 |
| LIE_Frequency | UPPS_PositiveUrgency | 0.16 | [ 0.09, 0.23] | 4.38 | < .001 | Pearson | 757 |
| LIE_Frequency | UPPS_LackOfPerseverance | 0.04 | [-0.03, 0.11] | 1.17 | 0.241 | Pearson | 757 |
| LIE_Frequency | UPPS_LackOfPremeditation | 0.01 | [-0.06, 0.09] | 0.41 | 0.683 | Pearson | 757 |
| LIE_Frequency | UPPS_SensationSeeking | 3.92e-03 | [-0.07, 0.08] | 0.11 | 0.914 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.16 | [-0.23, -0.09] | -4.58 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.31 | [ 0.25, 0.37] | 9.00 | < .001 | Pearson | 757 |
| LIE_Ability | UPPS_NegativeUrgency | 0.02 | [-0.05, 0.09] | 0.60 | 0.546 | Pearson | 757 |
| LIE_Ability | UPPS_PositiveUrgency | -0.04 | [-0.11, 0.03] | -1.18 | 0.238 | Pearson | 757 |
| LIE_Ability | UPPS_LackOfPerseverance | -0.02 | [-0.09, 0.05] | -0.46 | 0.643 | Pearson | 757 |
| LIE_Ability | UPPS_LackOfPremeditation | -0.04 | [-0.11, 0.03] | -1.03 | 0.301 | Pearson | 757 |
| LIE_Ability | UPPS_SensationSeeking | 0.07 | [ 0.00, 0.14] | 2.04 | 0.041 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.29 | [-0.35, -0.22] | -8.29 | < .001 | Pearson | 757 |
| LIE_Negativity | UPPS_NegativeUrgency | 0.10 | [ 0.03, 0.17] | 2.75 | 0.006 | Pearson | 757 |
| LIE_Negativity | UPPS_PositiveUrgency | 0.03 | [-0.05, 0.10] | 0.71 | 0.476 | Pearson | 757 |
| LIE_Negativity | UPPS_LackOfPerseverance | -0.08 | [-0.15, -0.01] | -2.15 | 0.032 | Pearson | 757 |
| LIE_Negativity | UPPS_LackOfPremeditation | -0.15 | [-0.21, -0.08] | -4.05 | < .001 | Pearson | 757 |
| LIE_Negativity | UPPS_SensationSeeking | 0.03 | [-0.04, 0.10] | 0.82 | 0.412 | Pearson | 757 |
| LIE_Contextuality | UPPS_NegativeUrgency | 0.03 | [-0.04, 0.10] | 0.84 | 0.402 | Pearson | 757 |
| LIE_Contextuality | UPPS_PositiveUrgency | -0.01 | [-0.08, 0.06] | -0.29 | 0.770 | Pearson | 757 |
| LIE_Contextuality | UPPS_LackOfPerseverance | -0.08 | [-0.15, 0.00] | -2.09 | 0.037 | Pearson | 757 |
| LIE_Contextuality | UPPS_LackOfPremeditation | -0.10 | [-0.17, -0.03] | -2.84 | 0.005 | Pearson | 757 |
| LIE_Contextuality | UPPS_SensationSeeking | 0.07 | [ 0.00, 0.14] | 2.00 | 0.046 | Pearson | 757 |
| UPPS_NegativeUrgency | UPPS_PositiveUrgency | 0.58 | [ 0.54, 0.63] | 19.81 | < .001 | Pearson | 757 |
| UPPS_NegativeUrgency | UPPS_LackOfPerseverance | -0.01 | [-0.08, 0.06] | -0.33 | 0.738 | Pearson | 757 |
| UPPS_NegativeUrgency | UPPS_LackOfPremeditation | 0.04 | [-0.03, 0.12] | 1.21 | 0.225 | Pearson | 757 |
| UPPS_NegativeUrgency | UPPS_SensationSeeking | -0.14 | [-0.21, -0.07] | -3.82 | < .001 | Pearson | 757 |
| UPPS_PositiveUrgency | UPPS_LackOfPerseverance | 8.67e-03 | [-0.06, 0.08] | 0.24 | 0.812 | Pearson | 757 |
| UPPS_PositiveUrgency | UPPS_LackOfPremeditation | 0.21 | [ 0.14, 0.27] | 5.81 | < .001 | Pearson | 757 |
| UPPS_PositiveUrgency | UPPS_SensationSeeking | 0.26 | [ 0.19, 0.32] | 7.27 | < .001 | Pearson | 757 |
| UPPS_LackOfPerseverance | UPPS_LackOfPremeditation | 0.38 | [ 0.32, 0.44] | 11.31 | < .001 | Pearson | 757 |
| UPPS_LackOfPerseverance | UPPS_SensationSeeking | -0.13 | [-0.20, -0.06] | -3.73 | < .001 | Pearson | 757 |
| UPPS_LackOfPremeditation | UPPS_SensationSeeking | 0.03 | [-0.04, 0.10] | 0.76 | 0.445 | Pearson | 757 |
graphdata_upps <- cor_upps %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_upps$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_upps$nodes$name, "LIE_"),
"LIE", "Impulsivity")
graphdata_upps$nodes$name <- stringr::str_remove(graphdata_upps$nodes$name, "LIE_|UPPS_")
graphdata_upps$nodes$name <- stringr::str_replace(graphdata_upps$nodes$name, "U", "\nU")
graphdata_upps$nodes$name <- stringr::str_replace(graphdata_upps$nodes$name, "OfP", " of\nP")
graphdata_upps$nodes$name <- stringr::str_replace(graphdata_upps$nodes$name, "nS", "n\nS")
ggm_upps <- create_ggm(graphdata_upps, title = "Impulsivity")
ggm_upps
Emotion Regulation (DERS)
cor_ders <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("DERS"), -DERS_General),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_ders)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.28 | [ 0.21, 0.34] | 7.92 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.56 | [-0.60, -0.51] | -18.46 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.15 | [-0.22, -0.08] | -4.11 | < .001 | Pearson | 757 |
| LIE_Frequency | DERS_Awareness | 0.04 | [-0.03, 0.11] | 1.04 | 0.297 | Pearson | 757 |
| LIE_Frequency | DERS_Clarity | 0.10 | [ 0.03, 0.17] | 2.85 | 0.005 | Pearson | 757 |
| LIE_Frequency | DERS_Goals | -0.06 | [-0.13, 0.01] | -1.76 | 0.078 | Pearson | 757 |
| LIE_Frequency | DERS_Impulse | 0.13 | [ 0.05, 0.19] | 3.47 | < .001 | Pearson | 757 |
| LIE_Frequency | DERS_NonAcceptance | 0.09 | [ 0.02, 0.16] | 2.58 | 0.010 | Pearson | 757 |
| LIE_Frequency | DERS_Strategies | 6.35e-03 | [-0.06, 0.08] | 0.17 | 0.861 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.15 | [-0.22, -0.08] | -4.26 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.33 | [ 0.26, 0.39] | 9.50 | < .001 | Pearson | 757 |
| LIE_Ability | DERS_Awareness | -0.06 | [-0.13, 0.01] | -1.67 | 0.096 | Pearson | 757 |
| LIE_Ability | DERS_Clarity | -0.06 | [-0.14, 0.01] | -1.78 | 0.075 | Pearson | 757 |
| LIE_Ability | DERS_Goals | -0.04 | [-0.11, 0.03] | -1.18 | 0.240 | Pearson | 757 |
| LIE_Ability | DERS_Impulse | 0.03 | [-0.04, 0.10] | 0.93 | 0.351 | Pearson | 757 |
| LIE_Ability | DERS_NonAcceptance | 2.82e-03 | [-0.07, 0.07] | 0.08 | 0.938 | Pearson | 757 |
| LIE_Ability | DERS_Strategies | 6.49e-03 | [-0.06, 0.08] | 0.18 | 0.859 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.26 | [-0.33, -0.19] | -7.46 | < .001 | Pearson | 757 |
| LIE_Negativity | DERS_Awareness | -0.06 | [-0.13, 0.01] | -1.60 | 0.111 | Pearson | 757 |
| LIE_Negativity | DERS_Clarity | 0.02 | [-0.05, 0.09] | 0.58 | 0.563 | Pearson | 757 |
| LIE_Negativity | DERS_Goals | -0.04 | [-0.11, 0.03] | -1.10 | 0.273 | Pearson | 757 |
| LIE_Negativity | DERS_Impulse | 0.06 | [-0.01, 0.13] | 1.70 | 0.090 | Pearson | 757 |
| LIE_Negativity | DERS_NonAcceptance | 0.11 | [ 0.04, 0.18] | 3.08 | 0.002 | Pearson | 757 |
| LIE_Negativity | DERS_Strategies | 2.58e-03 | [-0.07, 0.07] | 0.07 | 0.943 | Pearson | 757 |
| LIE_Contextuality | DERS_Awareness | -0.05 | [-0.12, 0.02] | -1.39 | 0.166 | Pearson | 757 |
| LIE_Contextuality | DERS_Clarity | -0.03 | [-0.10, 0.04] | -0.74 | 0.462 | Pearson | 757 |
| LIE_Contextuality | DERS_Goals | 0.03 | [-0.04, 0.10] | 0.79 | 0.428 | Pearson | 757 |
| LIE_Contextuality | DERS_Impulse | -0.01 | [-0.09, 0.06] | -0.40 | 0.689 | Pearson | 757 |
| LIE_Contextuality | DERS_NonAcceptance | 6.61e-03 | [-0.06, 0.08] | 0.18 | 0.856 | Pearson | 757 |
| LIE_Contextuality | DERS_Strategies | 0.02 | [-0.06, 0.09] | 0.43 | 0.670 | Pearson | 757 |
| DERS_Awareness | DERS_Clarity | 0.28 | [ 0.21, 0.34] | 7.93 | < .001 | Pearson | 757 |
| DERS_Awareness | DERS_Goals | -0.19 | [-0.26, -0.12] | -5.39 | < .001 | Pearson | 757 |
| DERS_Awareness | DERS_Impulse | 0.06 | [-0.02, 0.13] | 1.53 | 0.125 | Pearson | 757 |
| DERS_Awareness | DERS_NonAcceptance | -0.05 | [-0.12, 0.02] | -1.47 | 0.143 | Pearson | 757 |
| DERS_Awareness | DERS_Strategies | 0.02 | [-0.06, 0.09] | 0.43 | 0.669 | Pearson | 757 |
| DERS_Clarity | DERS_Goals | 0.03 | [-0.04, 0.10] | 0.82 | 0.410 | Pearson | 757 |
| DERS_Clarity | DERS_Impulse | 0.10 | [ 0.02, 0.17] | 2.63 | 0.009 | Pearson | 757 |
| DERS_Clarity | DERS_NonAcceptance | 0.17 | [ 0.10, 0.24] | 4.79 | < .001 | Pearson | 757 |
| DERS_Clarity | DERS_Strategies | 0.20 | [ 0.13, 0.27] | 5.61 | < .001 | Pearson | 757 |
| DERS_Goals | DERS_Impulse | 0.29 | [ 0.22, 0.35] | 8.22 | < .001 | Pearson | 757 |
| DERS_Goals | DERS_NonAcceptance | 0.17 | [ 0.10, 0.24] | 4.83 | < .001 | Pearson | 757 |
| DERS_Goals | DERS_Strategies | 0.23 | [ 0.17, 0.30] | 6.64 | < .001 | Pearson | 757 |
| DERS_Impulse | DERS_NonAcceptance | 0.07 | [-0.01, 0.14] | 1.79 | 0.074 | Pearson | 757 |
| DERS_Impulse | DERS_Strategies | 0.46 | [ 0.40, 0.52] | 14.29 | < .001 | Pearson | 757 |
| DERS_NonAcceptance | DERS_Strategies | 0.22 | [ 0.15, 0.29] | 6.19 | < .001 | Pearson | 757 |
graphdata_ders <- cor_ders %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_ders$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_ders$nodes$name, "LIE_"),
"LIE", "Emotion Regulation")
graphdata_ders$nodes$name <- stringr::str_remove(graphdata_ders$nodes$name, "LIE_|DERS_")
graphdata_ders$nodes$name <- stringr::str_replace(graphdata_ders$nodes$name, "nA", "n-\nA")
ggm_ders <- create_ggm(graphdata_ders, title = "Difficulties in Emotion Regulation")
ggm_ders
Interoception (MAIA2)
cor_maia <- correlation::correlation(
dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("MAIA2")),
partial = TRUE, p_adjust = "none")
parameters::parameters_table(cor_maia)| Parameter1 | Parameter2 | r | 95% CI | t(755) | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|
| LIE_Frequency | LIE_Ability | 0.28 | [ 0.21, 0.34] | 7.91 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Negativity | -0.54 | [-0.59, -0.49] | -17.86 | < .001 | Pearson | 757 |
| LIE_Frequency | LIE_Contextuality | -0.17 | [-0.23, -0.10] | -4.62 | < .001 | Pearson | 757 |
| LIE_Frequency | MAIA2_Noticing | -0.07 | [-0.14, 0.00] | -1.86 | 0.063 | Pearson | 757 |
| LIE_Frequency | MAIA2_BodyListening | 0.10 | [ 0.03, 0.17] | 2.89 | 0.004 | Pearson | 757 |
| LIE_Ability | LIE_Negativity | -0.16 | [-0.23, -0.09] | -4.52 | < .001 | Pearson | 757 |
| LIE_Ability | LIE_Contextuality | 0.33 | [ 0.27, 0.39] | 9.64 | < .001 | Pearson | 757 |
| LIE_Ability | MAIA2_Noticing | 0.08 | [ 0.01, 0.15] | 2.17 | 0.030 | Pearson | 757 |
| LIE_Ability | MAIA2_BodyListening | -0.01 | [-0.09, 0.06] | -0.38 | 0.703 | Pearson | 757 |
| LIE_Negativity | LIE_Contextuality | -0.27 | [-0.33, -0.20] | -7.58 | < .001 | Pearson | 757 |
| LIE_Negativity | MAIA2_Noticing | 0.05 | [-0.02, 0.12] | 1.36 | 0.173 | Pearson | 757 |
| LIE_Negativity | MAIA2_BodyListening | 0.04 | [-0.03, 0.11] | 1.03 | 0.305 | Pearson | 757 |
| LIE_Contextuality | MAIA2_Noticing | 1.15e-03 | [-0.07, 0.07] | 0.03 | 0.975 | Pearson | 757 |
| LIE_Contextuality | MAIA2_BodyListening | 0.04 | [-0.03, 0.11] | 1.10 | 0.274 | Pearson | 757 |
| MAIA2_Noticing | MAIA2_BodyListening | 0.56 | [ 0.50, 0.60] | 18.37 | < .001 | Pearson | 757 |
graphdata_maia <- cor_maia %>%
filter(p < .001) %>%
tidygraph::as_tbl_graph() %>%
as.list()
graphdata_maia$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_maia$nodes$name, "LIE_"),
"LIE", "Interoception")
graphdata_maia$nodes$name <- stringr::str_remove(graphdata_maia$nodes$name, "LIE_|MAIA2_")
graphdata_maia$nodes$name <- stringr::str_replace(graphdata_maia$nodes$name, "yL", "y\nL")
ggm_maia <- create_ggm(graphdata_maia, title = "Interoception")
ggm_maia
References
report::cite_packages(sessionInfo())> - Ben-Shachar, Makowski & Lüdecke (2020). Compute and interpret indices of effect size. CRAN. Available from https://github.com/easystats/effectsize.
> - Dirk Eddelbuettel and Romain Francois (2011). Rcpp: Seamless R and C++ Integration. Journal of Statistical Software, 40(8), 1-18. URL http://www.jstatsoft.org/v40/i08/.
> - Goodrich B, Gabry J, Ali I & Brilleman S. (2020). rstanarm: Bayesian applied regression modeling via Stan. R package version 2.21.1 https://mc-stan.org/rstanarm.
> - H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
> - Hadley Wickham (2019). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.4.0. https://CRAN.R-project.org/package=stringr
> - Hadley Wickham (2020). forcats: Tools for Working with Categorical Variables (Factors). R package version 0.5.0. https://CRAN.R-project.org/package=forcats
> - Hadley Wickham (2020). tidyr: Tidy Messy Data. R package version 1.1.2. https://CRAN.R-project.org/package=tidyr
> - Hadley Wickham and Jim Hester (2020). readr: Read Rectangular Text Data. R package version 1.4.0. https://CRAN.R-project.org/package=readr
> - Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2020). dplyr: A Grammar of Data Manipulation. R package version 1.0.2. https://CRAN.R-project.org/package=dplyr
> - Kirill Müller and Hadley Wickham (2020). tibble: Simple Data Frames. R package version 3.0.4. https://CRAN.R-project.org/package=tibble
> - Lionel Henry and Hadley Wickham (2020). purrr: Functional Programming Tools. R package version 0.3.4. https://CRAN.R-project.org/package=purrr
> - Lüdecke D, Ben-Shachar M, Patil I, Makowski D (2020). "parameters:Extracting, Computing and Exploring the Parameters of StatisticalModels using R." _Journal of Open Source Software_, *5*(53), 2445. doi:10.21105/joss.02445 (URL: https://doi.org/10.21105/joss.02445).
> - Lüdecke D, Waggoner P, Makowski D (2019). "insight: A Unified Interfaceto Access Information from Model Objects in R." _Journal of Open SourceSoftware_, *4*(38), 1412. doi: 10.21105/joss.01412 (URL:https://doi.org/10.21105/joss.01412).
> - Lüdecke, Ben-Shachar, Waggoner & Makowski (2020). Visualisation Toolbox for 'easystats' and Extra Geoms, Themes and Color Palettes for 'ggplot2'. CRAN. Available from https://easystats.github.io/see/
> - Lüdecke, Makowski, Waggoner & Patil (2020). Assessment of Regression Models Performance. CRAN. Available from https://easystats.github.io/performance/
> - Makowski, D., Ben-Shachar, M. S. & Lüdecke, D. (2020). *Estimation of Model-Based Predictions, Contrasts and Means*. CRAN.
> - Makowski, D., Ben-Shachar, M. S. & Lüdecke, D. (2020). *Estimation of Model-Based Predictions, Contrasts and Means*. GitHub.
> - Makowski, D., Ben-Shachar, M. S., Patil, I., & Lüdecke, D. (2019). Methods and Algorithms for Correlation Analysis in R. Journal of Open Source Software, 5(51), 2306. 10.21105/joss.02306
> - Makowski, D., Ben-Shachar, M., & Lüdecke, D. (2019). bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework. Journal of Open Source Software, 4(40), 1541. doi:10.21105/joss.01541
> - Makowski, D., Lüdecke, D., & Ben-Shachar, M.S. (2020). Automated reporting as a practical tool to improve reproducibility and methodological best practices adoption. CRAN. Available from https://github.com/easystats/report. doi: .
> - R Core Team (2020). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
> - Thomas Lin Pedersen (2020). ggforce: Accelerating 'ggplot2'. R package version 0.3.2. https://CRAN.R-project.org/package=ggforce
> - Thomas Lin Pedersen (2020). ggraph: An Implementation of Grammar of Graphics for Graphs and Networks. R package version 2.0.3. https://CRAN.R-project.org/package=ggraph
> - Thomas Lin Pedersen (2020). tidygraph: A Tidy API for Graph Manipulation. R package version 1.2.0. https://CRAN.R-project.org/package=tidygraph
> - Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
> - Yihui Xie (2020). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.30.
Social Desirability (BIDR)